爲什麼我的VBA代碼有時會工作，而大部分時間不是？

Question

Sub UpdateCSAH() 
Dim S As String 
Dim R As Long 
Dim RR As Long 
Dim CC As Long 
Dim i As Long 
Dim j As Long 
Dim csah() As String 'an array that stores the CSAH sites 
ReDim csah(1 To 100, 1 To 7) 
Dim Ran As Range 
Dim Ran1 As Range 
Set Ran = Worksheets("Current Sites").Range("A1").CurrentRegion 'Ran is the region that has values 
RR = 1 'row number in csah 
CC = 1 'column number in csah 

'check each value in Ran to see if its Route section has "CSAH" 
For Each cell In Ran 
    R = cell.row 
    S = CStr(Cells(R, 4).value) 
    If InStr(S, "CSAH") > 0 Then 'check if "CSAH" is in the Route section 
     If CC > 7 Then 'reset the column number and go to the next row when reach the end of the column 
      CC = 1 
      RR = RR + 1 
     End If 
     csah(RR, CC) = cell.value 
     CC = CC + 1 
    End If 
Next cell 

Worksheets("CSAH Sites").Select 
Range("A2:G100").Select 
Selection.ClearContents 

'assign each array values to cells in sheet"CSAH Sites" 
i = 1 
j = 1 
For i = 1 To UBound(csah, 1) 
    For j = 1 To UBound(csah, 2) 
     Cells(i + 1, j) = csah(i, j) 
    Next j 
Next i 

'format the CSAH Sites values 
Set Ran1 = Worksheets("CSAH Sites").Range("A1").CurrentRegion 
For Each cell In Ran1 
    If cell.row = 1 Then 
     With cell.Font 
      .Color = -11489280 
     End With 
    ElseIf cell.row Mod 2 = 0 Then 
     With cell.Interior 
      .Color = 10092441 
     End With 
    End If 
Next cell 

End Sub 

我有一個名爲「當前網站」的Excel工作表，有一些數據。如果第4列有單詞「CSAH」，我想將該行的值存儲到數組中，並將這些值分配給名爲「CSAH Sites」的工作表中的單元格。我的代碼有時可用（第一次點擊），大多數時候它不起作用或無法正常工作。

請幫我一把！感謝一束！

Answer 1

看起來你想要檢查「當前網站」表中的每一行數據，如果第4列包含「CSAH」文本，則將該條目的前7列數據寫入「CSAH站點」併爲偶數行添加一些顏色。

要檢查每一行數據，只能讀取一列，並使用Offset或Cells方法查看相鄰單元的值。在你的代碼中，你「觸摸」了每個單元格，並且每次當你查看第4列中的值時，還要檢查代碼是否已經過了第7列。這會使事情減慢很多，使代碼很難理解。

您還可以將一系列單元格中的值直接分配給另一個單元格區域，而無需使用變量或數組。

看看這個你想要做什麼：

Sub UpdateCSAH() 

Dim currentSitesRange As Range 
Dim thisSiteRange As Range 
Dim outputCell As Range 
Dim numRowsOfData As Long 

Const NUM_COLUMNS_OF_DATA As Integer = 7 

    Set currentSitesRange = Worksheets("Current Sites").Range("A1") 
    numRowsOfData = currentSitesRange.CurrentRegion.Rows.Count 
    Set currentSitesRange = currentSitesRange.Resize(RowSize:=numRowsOfData) 'currentSitesRange is the region that has values 

    Worksheets("CSAH Sites").Range("A2:G100").ClearContents 

    Set outputCell = Worksheets("CSAH Sites").Range("A2") 

    For Each thisSiteRange In currentSitesRange.Cells 
     ' Look for "CSAH" in the Route section (column D) 
     If InStr(1, thisSiteRange.Offset(ColumnOffset:=3).Value, "CSAH", vbTextCompare) > 0 Then 
      ' Found "CSAH" so write NUM_COLUMNS_OF_DATA columns of data to CSAH Sites sheet 
      outputCell.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Value = thisSiteRange.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Value 
      ' Format the even-numbered rows 
      If outputCell.Row Mod 2 = 0 Then 
       With outputCell.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Interior 
        .Color = 10092441 
       End With 
      End If 
      Set outputCell = outputCell.Offset(RowOffset:=1) 
     End If 
    Next thisSiteRange 

End Sub