動的セルを使用してワークブック間でデータをコピーする

Dec 21 2020

あるExcelスプレッドシートから別のスプレッドシートに(New_dataからレポートに)データをコピーしようとしています。

New_dataスプレッドシートで、2回目のシステム(したがって、最初のシステムの下で検索を開始する理由N21)が表示されたら、空白のセルに到達するまで、その下のすべてのデータを列b〜kからコピーする必要があります。満たされたセルのみをキャプチャする行数を取得するにはどうすればよいですか?

Range("B584:K641") 動的である必要があります。


Sub CopyWorkbook()
 Range("N21").Select
    Cells.Find(What:="system", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range("B584:K641").Select
    Selection.Copy
    Application.WindowState = xlNormal
    Windows("report.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Windows("new_data.csv"). _
    Activate
End Sub

回答

3 FaneDuru Dec 21 2020 at 21:42

次のコードを試してください。非常に高速である必要があります(「システム」を検索する場所を正しく理解していれば、何から始めますか...)。このコードは、「new_data.csv」がcsvワークブック名​​であることを前提としています。そうでない場合は、shCSVシートを定義するときにその本名を使用する必要があります。

Sub CopyWorkbook()
 Dim shR As Worksheet, shCSV As Worksheet, lastRow As Long, systCell As Range, arr

 Set shR = Workbooks("report.xlsx").ActiveSheet   'use here the sheet you need to paste
                                                  'it should be better to use the sheet name. 
                                                  'No need to have the respective sheet activated at the beginning
 Set shCSV = Workbooks("new_data.csv").Sheets(1)  'csv file has a single sheet, anyhow
 lastRow = shCSV.Range("B" & rows.count).End(xlUp).row

  Set systCell = shCSV.Range("B21:B" & lastRow).Find(What:="system", _
             After:=shCSV.Range("B21"), LookIn:=xlFormulas, LookAt _
             :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                                                        False, SearchFormat:=False)
  If systCell Is Nothing Then MsgBox "No 'sytem' cell has been found...": Exit Sub
  arr = shCSV.Range(systCell, shCSV.Range("K" & lastRow)).Value
  shR.Range("A2").Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub
1 FoxfireAndBurnsAndBurns Dec 21 2020 at 20:34

試してみてください:

Sub test()

Dim LR As Long
Dim Ini As Long
LR = Range("B" & Rows.Count).End(xlUp).Row 'last non empty row in column B

Ini = Application.WorksheetFunction.Match("system", Range("N21:N" & LR), 0) + 20 'position of system after n21

Range("B" & Ini & ":K" & LR).Copy

'''rest of your code to paste
End Sub

このコードはsystem列Nでのみ単語を検索していることに注意してください。それが別の場所にある場合は、MATCH関数を適応させる必要があります。

1 TestPilot10 Dec 21 2020 at 20:28

フィルター処理された範囲と等しくなるように範囲を設定し、ループを開始して、列Bの最初の空のセルまでに空のセルが発生しない数をカウントします。

    Sub CopyWorkbook()
        ThisWorkbook.Sheets("new_data").Activate
        Range("N21").Select
        Dim rng As Range
        Set rng = Cells.Find(What:="system", After:=ActiveCell, _
        LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
        MatchCase:=False, _
        SearchFormat:=False)
        Dim i As Double
        i = rng.Row
        Do Until ThisWorkbook.Sheets("new_data").Range("B" & i) = vbNullString
            i = i + 1
        Loop
        i = i - 1
        Range("B" & rng.Row & ":K" & i).Select
        Selection.Copy
        Application.WindowState = xlNormal
        Windows("report.xlsx").Activate
        Range("A2").Select
        ActiveSheet.Paste
        Windows("new_data.csv").Activate
    End Sub

答えを見つけるのに役立つStackOverflowの質問を見つけました。セルアドレスを探す