選擇和粘貼單元格

我對VBA相對比較陌生，我只有一些Python的使用經驗，只有很少的經驗來看待其他VBA宏，並根據我的需要調整它們，所以我正在嘗試盡我所能。選擇和粘貼單元格

我想要做的是每個零件號粘貼在工作表B（工作表B，行A）我想從包含所有零件號（工作表D，行A）的不同工作表中找到相同的零件號和將工作表D中的描述（工作表D，行H）複製到另一列（工作表B，行D），然後檢查行中的下一個零件編號並重復。

我得到的當前錯誤是有「編譯錯誤：否則如果」，我很抱歉，我不是很精通，但任何幫助將不勝感激。

其他信息：

-My零件號通過工作表B到搜索，B列從工作表中填寫，是它沒關係只是使它= A B2或= CONCATENATE（A B2！）！？

Sub Description() 

Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet 
Dim Rng As Range 
Set wsB = Worksheets("B") 
Set wsD = Worksheets("D") 

Do: aRow = 2 
     If wsB.Cells(aRow, 2) <> "" Then 
    With Worksheets("D").Range("A:A") 
     x = wsB.Cells(aRow, 2) 
     Set Rng = .Find(What:=x, _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlValues, _ 
         LookAt:=xlWhole, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 

     Selection.Copy 
     wsB.Cells(dRow, 2).Paste 
    dRow = dRow + 1 
    Else 
     aRow = aRow + 1 

Loop Until wsB.Cells(aRow, 2) = "" 
End Sub

再次感謝！

編輯：在中斷模式下不能執行的代碼是當前的錯誤

Sub Description() 
Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet 
Dim Rng As Range 
Set wsB = Worksheets("B") 
Set wsD = Worksheets("D") 
aRow = 2 
dRow = 2 

    Do: 
     If wsB.Cells(aRow, 1) <> "" Then 
      With Worksheets("D").Range("A:A") 
       Set Rng = .Find(What:=wsB.Cells(aRow, 1), _ 
           After:=.Cells(.Cells.Count), _ 
           LookIn:=xlValues, _ 
           LookAt:=xlWhole, _ 
           SearchOrder:=xlByRows, _ 
           SearchDirection:=xlNext, _ 
           MatchCase:=False) 
       Rng.Copy 
       Rng.Offset(0, 3).Paste (Cells(aRow, 4)) 
       dRow = dRow + 1 
       aRow = aRow + 1 
      End With 
     End If 
    Loop Until wsB.Cells(aRow, 1) = "" 
End Sub

來源

2015-01-15 Ryan

你可以嘗試把End If下一行aRow = aRow + 1後。請參閱MSDN的語法msdn.microsoft.com/en-us/library/752y8abs.aspx

來源

2015-01-15 00:33:32 zmechanic

我相信'Else'之前的'End With'也是必需的。實際上，更好的方法是將'With ... End With'塊移到'For ... Next'循環之外，因爲它不會被for ... next中的任何東西重新定義。 – Jeeped

是的。在VBA多行語句中需要'End ***' – zmechanic

我把aRow和dRow定義放在Do之上：所以它不會在每次循環時重置 – Ryan

在Excel中，我們通常將垂直範圍稱爲列，將水平範圍稱爲行。從您的代碼和問題描述中，我假設您所說的「行A」是A列。此外，您的代碼通過wsB.Cells（aRow，2）掃描。它是列B而不是列A. 無論如何，這只是一個小問題。

下面的代碼將檢查工作表B的B列的單元如果相同的值被發現在工作表d的列A，然後在工作表的d H列的cooresponding單元將被複制到在列中的單元B的工作表B.

Option Explicit 
Sub Description() 
    Dim wsB As Worksheet, wsD As Worksheet, aRow As Long 
    Dim rngSearchRange As Range, rngFound As Range 
    Set wsB = Worksheets("B") 
    Set wsD = Worksheets("D") 
    Set rngSearchRange = wsD.Range("A:A") 
    aRow = 2 
    Do While wsB.Cells(aRow, 2).Value <> "" 
     Set rngFound = rngSearchRange.Find(What:=wsB.Cells(aRow, 2).Value, LookAt:=xlWhole) 
     If Not rngFound Is Nothing Then 
     wsD.Cells(rngFound.Row, 8).Copy Destination:=wsB.Cells(aRow, 4) ' Indexes of Column H, D are respectively 8, 4 
     End If 
     aRow = aRow + 1 
    Loop 
End Sub

來源

2015-01-15 05:03:50

謝謝！這對我來說非常接近，一個問題是它沒有找到這些項目，但只是粘貼它們，所以如果我有12個項目將其粘貼到工作表D的前12個。 – Ryan

是否以某種方式檢查工作表B而不是D ，以便它每次匹配並從工作表D粘貼？ – Ryan

這是什麼爲我工作。

Sub Description() 
    Application.ScreenUpdating = False 
    Dim LastRow As Long 
    LastRow = Sheets("B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    Dim rng As Range 
    Dim foundRng As Range 
    For Each rng In Sheets("B").Range("B2:B" & LastRow) 
     Set foundRng = Sheets("D").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole) 
     If Not foundRng Is Nothing Then 
      Sheets("B").Cells(rng.Row, "D") = Sheets("D").Cells(foundRng.Row, "H") 
     End If 
    Next rng 
    Application.ScreenUpdating = True 
End Sub

來源

2015-01-15 19:29:10 Ryan

選擇和粘貼單元格

回答

相關問題