Salin data antara buku kerja dengan sel dinamis

Dec 21 2020

Mencoba menyalin data dari satu spreadsheet Excel ke yang lain (dari New_data ke laporan).

Dalam spreadsheet New_data saya menemukan Sistem kedua kalinya (oleh karena itu mengapa saya memulai pencarian di bawah yang pertama di N21) muncul maka saya perlu menyalin semua data di bawahnya dari kolom b - k sampai saya mencapai sel kosong. Bagaimana cara mendapatkan jumlah baris untuk hanya menangkap sel yang terisi?

Range("B584:K641") harus dinamis.


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

Jawaban

3 FaneDuru Dec 21 2020 at 21:42

Silakan coba kode berikutnya. Ini harus sangat cepat (jika saya benar mengerti di mana harus mencari 'sistem', dimulai dengan apa ...). Kode mengasumsikan bahwa "new_data.csv" adalah nama buku kerja csv. Jika tidak, Anda harus menggunakan nama aslinya saat menentukan shCSVsheet:

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

Mencoba:

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

Perhatikan bahwa kode ini mencari kata systemhanya di kolom N. Jika berada di tempat lain, Anda harus menyesuaikan fungsi MATCH

1 TestPilot10 Dec 21 2020 at 20:28

Saya menetapkan rentang untuk menyamakan rentang yang difilter dan memulai loop untuk menghitung berapa banyak tidak ada sel kosong yang terjadi hingga sel kosong pertama di kolom 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

Saya menemukan pertanyaan Stack Overflow yang sangat membantu dalam menemukan jawaban. Temukan alamat sel