アプリ版:「スタンプのみでお礼する」機能のリリースについて

マクロでCSVファイルを取込むプログラムを作成しております。

最終行を取得するソースまではできたのですが、最終列を取得する処理ができておりません。
教えて頂けないでしょうか。

処理概要
(1)ボタンを押したら、Sheet2にCSVファイルがインポートされる
(2)Sheet2に出力されたA2行~A8行とA2行~A8行の最終列までをSheet1のD4行~D10行、D4行~D10行の列にコピー 
(3)Sheet2に出力されたA9行目はコピーしない
(4)Sheet2に出力されたA10行以降とA10行以降の最終列までをSheet1のA13行以降の最終列までにコピー

現在のソースは(2)、(4)の最終列を取得するソース以外はできています。
(2)、(4)の最終列を取得し、コピーする方法を教えて下さい。

現在のソースです。
Sub READ_TextFile()

Dim LoadFileName As String
Dim LR As Long

'選んだcsvファイルをSheet1に読み込む
LoadFileName = Application.GetOpenFilename("CSVファイル(*.csv),*.csv", 1, "読み込むcsvファイルを選んで下さい", False)
If LoadFileName = "False" Then Exit Sub
Workbooks.Open LoadFileName
Cells.Copy ThisWorkbook.Sheets("Sheet2").Range("A1")
ActiveWorkbook.Close False

'Sheet2のA2:A8をSheet1のD4を先頭セルとする範囲にCopy
Worksheets("Sheet2").Range("A2:A8").Copy Worksheets("Sheet1").Range("D4")
'Sheet2のA列のデータのある最終行を取得しLRという変数に入れる
LR = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
'Sheet2のA10からA列の最終行までをSheet1のA13を先頭セルとする範囲にCopy
Worksheets("Sheet2").Range("A10:A" & LR).Copy Worksheets("Sheet1").Range("A13")

End Sub

A 回答 (1件)

2:8行の最終セルと10行以降の最終セルをきっちりと分けて判定する必要がある場合は


Sub test()
  Dim r As Range
  Dim rr As Range

  With Worksheets("Sheet2")
    Set r = .Rows("2:8").Cells
    '2:8行間の最終列のセルを取得
    Set r = r.Find(What:="*", _
            After:=r(1), _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious, _
            MatchByte:=False)
    If Not r Is Nothing Then
      If r.Column >= .Columns.Count - 3 Then
        MsgBox "error"
      Else
        Set r = .Range("A2:A8").Resize(, r.Column)
        MsgBox r.Address
      End If
    End If
    '10行以降のデータ範囲を取得
    Set r = Intersect(.Rows("10:" & .Rows.Count), .UsedRange)
    If Not r Is Nothing Then
      '念のためA10起点でSetし直し
      Set r = .Range("A10", r.Cells(r.Count))
      '10行以降のデータ範囲内の最終列のセルを取得
      Set rr = r.Find(What:="*", _
              After:=r(1), _
              LookIn:=xlFormulas, _
              LookAt:=xlPart, _
              SearchOrder:=xlByColumns, _
              SearchDirection:=xlPrevious, _
              MatchByte:=False)
      Set r = r.Columns(1).Resize(, rr.Column)
      MsgBox r.Address
    End If
  End With
End Sub
..こんな感じになりますが

アバウトで構わなければ
Sub test2()
  Dim r As Range

  With Worksheets("Sheet2")
    Set r = .UsedRange.SpecialCells(xlCellTypeLastCell)
    MsgBox .Range("A2:A8").Resize(, r.Column).Address
    If r.Row > 9 Then
      MsgBox .Range("A10", r).Address
    End If
  End With
End Sub
..これで良い場合もあります。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています