Excel 2010 VBA腳本

Question

我是一個使用VBA的完全新手，但已經成功地將以下代碼拼湊在一起，這適用於我的工作表中已將代碼分配給命令按鈕的工作表。我的問題是，我的工作表有超過3000行，我真的不想創建3000個按鈕。

我目前的想法是有一個腳本搜索特定條件的單元格範圍（即真），然後運行我的原始代碼作爲與條件匹配的每個單元格的下標。我試圖創建一個循環來匹配正在搜索的條件，但不知道如何將結果設置爲活動單元格。

任何人都可以給我一些指示，如何實現這一點或提出更好的解決方案？ 謝謝。

Sub Send_FWU_to_E_Drive() 

Dim aTemp As String 
Dim bTemp As String 
Dim cTemp As String 
Dim dTemp As String 
Dim eTemp As String 
Dim subdir As String 

aTemp = "c:\test\" 
bTemp = "E:\romdata\" 
cTemp = ActiveCell.Offset(, -5) & ".fwu" 
dTemp = ActiveWorkbook.path 
eTemp = "\Firmware files" 
subdir = "\Firmware Files\" & ActiveCell.Offset(, -5) & "\" & ActiveCell.Offset(, -5) & ".fwu" 

MsgBox "The path of the active workbook is " & dTemp & subdir 

If Dir(dTemp & subdir) = "" Then 
MsgBox "Please check the file and ensure it is suitable for firmware updating with an SD card." 
Exit Sub 
End If 

MsgBox "The file " & cTemp & " is being copied to " & bTemp 

If Dir("e:\romdata", vbDirectory) = "" Then MkDir "E:\romdata" 

If Dir(bTemp & "nul") = "" Then 
MsgBox "The Destination Directory is missing, please ensure your SD Card is formatted, mapped as drive E and has a romdata directory." 
Exit Sub 

End If 

FileCopy dTemp & subdir, bTemp & cTemp 

End Sub 

Answer 1

首先修改你的函數接受一系列的參數，我們稱之爲細胞：

Sub Send_FWU_to_E_Drive(cell as Excel.Range) 

然後換cell所有在該子的ActiveCell引用。

下面的sub循環遍歷活動工作表B列中的每個單元格，如果它爲TRUE，則使用該行的列A中的單元格調用您的例程。所以你在代碼偏移量Send_FWU_to_E_Drive都是相對於列A這段代碼是未經測試的細胞，而應該是接近：

Sub Test 
Dim Cell as Excel.Range 
Dim LastRow as Long 

With ActiveSheet 
    LastRow = .Range("A" & .Rows.Count).End(xlup).Row 
    For Each Cell in .Range("B2:B" & LastRow) 'Search for TRUE in column B 
     If Cell.Value = TRUE Then 
      Send_FWU_to_E_Drive cell.Offset(0,-1) 'Column A Cell 
     End If 
    Next Cell 
End With 
End Sub 

編輯：每@亞洲時報Siddharth的建議，這裏有一個查找/ FindNext中的版本：

Sub Test() 
Dim cell As Excel.Range 
Dim LastRow As Long 
Dim SearchRange As Excel.Range 
Dim FirstFindAddress As String 

With ActiveSheet 
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row 
    Set SearchRange = .Range("B2:B" & LastRow) 'Search for TRUE in column B 
    Set cell = SearchRange.Find(what:=True, after:=SearchRange.Cells(1)) 
    If Not cell Is Nothing Then 
     FirstFindAddress = cell.Address 
     Send_FWU_to_E_Drive cell.Offset(0, -1) 
     Do 
      Send_FWU_to_E_Drive cell.Offset(0, -1) 
      Set cell = SearchRange.FindNext(after:=cell) 
     Loop While Not cell Is Nothing And cell.Address <> FirstFindAddress 
    End If 
End With 
End Sub