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

我有一个名为＆＃34;当前网站＆＃34;的Excel工作表。有一些数据。如果第4列有单词＆＃34; CSAH＆＃34;，我想将该行的值存储到数组中，并将这些值分配给名为＆＃34; CSAH Sites＆＃34;的工作表中的单元格。我的代码有时会起作用（第一次点击），而且大多数情况下它无法正常工作或无法正常工作。

请帮帮我！谢谢A Bunch !!

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

为什么我的VBA代码有时会起作用，而且大部分时间它都没有？

1 个答案: