我對 VBA 很陌生,我有一個非常具體的要求,我可以使用一些幫助來弄清楚。
Sub Button2_Click()
Dim OpenFileName As String
Dim wb As Workbook
'Select and Open workbook
OpenFileName = Application.GetOpenFilename
If OpenFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(OpenFileName)
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
'Use (1) instead of "Sheet1" or "Learners" to reference the first sheet within the workbook
Set wsCopy = Workbooks("Excel Test1.xlsx").Worksheets("Sheet1")
Set wsDest = Workbooks("Excel Test2.xlsm").Worksheets("Learners")
'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("A2:E" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)
wsDest.Range("G2").Value = WorksheetFunction.Match(wsDest.Range("F2").Value, wsCopy.Range("A2:A11"), 0)
MsgBox ("Done")
End Sub
上面的代碼用于按鈕內部,以便打開不同的 Excel 電子表格并將資料復制到我的“主電子表格”中。
使用正在復制并粘貼到主電子表格中的資料,我還希望能夠檢查 ID 列,如果有任何 ID 匹配,我想用匯入的電子表格中的所有相應 ID 資料替換匹配的 ID 行.
下面的所有資料都是虛擬資料,不是真實的,但是例如,如果 ID 5 (John Harris) 與 ID 5 (Michael Bailey) 匹配,那么我希望將 Michael Bailey 的所有資料替換為 John Harris 的資料。


我希望我所寫的內容有意義,我將不勝感激。
uj5u.com熱心網友回復:
嘗試這個:
Sub Button2_Click()
Dim OpenFileName As String
Dim wb As Workbook
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim m, rw As Range
OpenFileName = Application.GetOpenFilename 'Select and Open workbook
If OpenFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(OpenFileName, ReadOnly:=True)
Set wsCopy = wb.Worksheets("Data") 'for example
For Each rw In wsCopy.Range("A2:E" & wsCopy.Cells(Rows.Count, "A").End(xlUp).Row).Rows
'matching row based on Id ?
m = Application.Match(rw.Cells(1).Value, wsDest.Columns("A"), 0)
'if we didn't get a match then we add a new row
If IsError(m) Then m = wsDest.Cells(Rows.Count, "A").End(xlUp).Row 'new row
rw.Copy wsDest.Cells(m, "A") 'copy row
Next rw
wb.Close False 'no save
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/caozuo/341100.html
