Excel VBA將匹配信息從一個工作表複製到另一個工作表

我試圖讓Excel中的宏工作。Excel VBA將匹配信息從一個工作表複製到另一個工作表

現在我有一個名爲「Forms」的工作表，它有3列 - 標題（在第1行）是A =表格編號，B =表格名稱，C =零件我也有一個名爲Ins的工作表，相同的確切標題，並已填入信息。

我試圖讓它能夠在列A中的「表單」中輸入表單編號，並從Ins中自動爲列B和C複製信息。我現在在代碼中擁有EntireRow ，但我更喜歡它，如果我可以具體只複製到列A到C，但我想不出如何。

這是我目前嘗試使用代碼：

Private Sub Auto() 

Application.ScreenUpdating = False 
Dim wks1 As Worksheet, wks2 As Worksheet 

Dim j As Integer 
Dim i As Integer 

Set wks1 = Sheets("Forms") 
Set wks2 = Sheets("Ins") 

lastline = wks1.UsedRange.Rows.Count 

For i = 2 To lastline 

wks2.Cells(1, 1).CurrentRegion.AutoFilter 
wks2.Cells(1, 1).CurrentRegion.AutoFilter 1, wks1.Cells(i, 1).Value 
wks2.Cells(1, 1).CurrentRegion.EntireRow.Copy wks1.Cells(i, 1) 
wks2.Cells(1, 1).CurrentRegion.AutoFilter 


Next i 


End Sub

來源

2013-09-25 Amaress

我知道你想在'A'列中輸入'表格名稱'並自動填充'B'和'C'？ *'我現在在代碼中擁有EntireRow，但是我更喜歡它，如果我可以專門將它複製到列A到C，但我想不出如何。「*您能否詳細說明一下？ – 2013-09-25 15:57:07

工作表單元列A中每個表單只有一個實例嗎？爲什麼你需要在VBA和循環中做到這一點？爲什麼不使用Vlookup或索引/匹配？ – user2140261

Tim在下面爲我解決了EntireRow問題......現在我遇到的問題是隻有標題被複制。我無法使用匹配，因爲我需要將值複製到記錄保存中，Ins中的值有時會更改 – Amaress

wks2.Cells(1, 1).CurrentRegion.Resize(,3).Copy wks1.Cells(i, 1)

編輯：這樣的事情會更好，我覺得

Private Sub Auto() 

Application.ScreenUpdating = False 
Dim wks1 As Worksheet, wks2 As Worksheet 
Dim f As Range, frmNum 
Dim lastLine As Long 

Dim j As Integer 
Dim i As Integer 

Set wks1 = Sheets("Forms") 
Set wks2 = Sheets("Ins") 

lastLine = wks1.UsedRange.Rows.Count 

For i = 2 To lastLine 
    frmNum = wks1.Cells(i, 4).Value 
    If Len(frmNum) > 0 Then 
     Set f = wks2.Columns(1).Find(frmNum, LookIn:=xlValues, lookat:=xlWhole) 
     If Not f Is Nothing Then 
      f.Offset(0, 1).Resize(1, 9).Copy wks1.Cells(i, 5) 
     Else 
      wks1.Cells(i, 5).Value = "??" 
     End If 
    End If 
Next i 


End Sub

來源

2013-09-25 16:12:27

難道這只是一遍又一遍地複製頭文件？ – user2140261

我沒有仔細閱讀這個問題，但我認爲OP知道他們想要什麼：如果'EntireRow'爲他們工作，但他們不是複製整行，但只是前3列，那麼我的答案就是這樣... –

正在複製的標題是我遇到的問題之一。這雖然解決了我的EntireRow問題！謝謝！ – Amaress

這裏更多的是對我的意思在我的評論中，如果你只是想要你所要求的，可以使用公式來完成它：

公式可能是：

B2 = =IF(A2<>"",VLOOKUP(A2,Ins!$A$1:$C$14,2,FALSE),"")

和

C2 = =IF(A2<>"",VLOOKUP(A2,Ins!$A$1:$C$14,3,FALSE),"")

如果宏工作表看起來是這樣的：

enter image description here

然後你表格的工作表看起來像這樣的公式拖下來後：

enter image description here

來源

2013-09-25 16:19:31 user2140261

這將工作，除了我需要他們複製，他們可以' t是可變的 – Amaress

我最終通過添加第三個工作簿並在列A中輸入表單編號來完成此工作！

Private Sub Auto() 

Application.ScreenUpdating = False 
Dim wks1 As Worksheet, wks2 As Worksheet 

Dim j As Integer 
Dim i As Integer 

Set wks1 = Sheets("Form Worksheet") 
Set wks2 = Sheets("Instructions") 
Set wks3 = Sheets("To Do") 

lastline = wks1.UsedRange.Rows.Count 

For i = 2 To lastline 

wks2.Cells(2, 1).CurrentRegion.AutoFilter 
wks2.Cells(2, 1).CurrentRegion.AutoFilter 1, wks3.Cells(i, 1).Value 
wks2.Cells(2, 1).CurrentRegion.Offset(1).Resize(, 10).Copy 
wks1.Cells(i, 4).PasteSpecial Paste:=xlPasteValues 
wks2.Cells(2, 1).CurrentRegion.AutoFilter 


Next i 


End Sub

但我最終使用蒂姆的版本。

謝謝你們！

來源

2013-09-26 03:15:23 Amaress

Excel VBA將匹配信息從一個工作表複製到另一個工作表

回答

相關問題