動的セルを使用してワークブック間でデータをコピーする
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の質問を見つけました。セルアドレスを探す