在 Excel 中查找字符串並將列字母存儲在變量 VBA 中

Question

我想在工作簿中每個工作表的第一行中找到字符串“TOTAL”，並將這些列字母寫在新工作表中。

這是我到目前為止所得到的。 我可以找到字符串並獲取列字母並將其顯示在消息框中。 我試圖將結果存儲在一個變量中，但是我不知道如何將變量寫回已經存在的工作表中。

Sub Find()
    Dim rngResult As Range
    Dim strToFind As String
    Dim addCell As Range
    
    strToFind = "TOTAL"
    With Worksheets("Stand.1").UsedRange
        Set rngResult = .Find(What:=strToFind, LookAt:=xlPart)
        
        If Not rngResult Is Nothing Then
            Dim firstAddress As String, result As String
            firstAddress = rngResult.Address
        Do
            result = result & rngResult.Address & ","
            Set rngResult = .FindNext(rngResult)
            Loop While rngResult.Address <> firstAddress
                output = Mid(result, 2, 1)
                MsgBox "Found """ & strToFind & """ in column: " & output
                Set addCell = Worksheets("Stand.1").Range(.Address)
                End If
        End With
End Sub

Answer 1

調整總計（列）

• 以下將循環遍歷包含此代碼的工作簿 ( ThisWorkbook ) 的工作表。 它將跳過名稱在Exceptions Array的工作表。
• 對於每個工作表，它將嘗試在第一行（標題行）中找到字符串“TOTAL”，並將工作表的名稱寫入第一列，將列號寫入Data Array的第二列。
• 同時它會計算最大的列數（ MaxColumn ）。
• 使用在Data Array收集的值，它將插入空列以將每個工作表中的Totals Column調整為相同（最大列），例如所有工作表可能在列Z有Totals Column 。

編碼

Option Explicit

Sub adjustTotals()
    
    Const hRow As Long = 1
    Const hTitle As String = "TOTAL"
    ' The Exceptions Array contains the names of the worksheets you want
    ' to exclude from the adjustment.
    Dim Exceptions As Variant
    Exceptions = Array("Sheet728") ' add more
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    ' Define Data Array ('Data').
    Dim Data As Variant
    ' First column for worksheet name, second for totals column number.
    ReDim Data(1 To wb.Worksheets.Count, 1 To 2)
    
    ' Additional variables for the upcoming 'For Each Next' loop.
    Dim ws As Worksheet          ' Current Worksheet
    Dim CurrentValue As Variant  ' Current Totals Column Number
    Dim MaxColumn As Long        ' Max Column Number
    Dim i As Long                ' Data Array Row Counter
    
    ' Write worksheet name and total column number to Data Array and
    ' define Max Column Number.
    For Each ws In wb.Worksheets
        If UBound(Exceptions) >= LBound(Exceptions) Then
            If Not IsError(Application.Match(ws.Name, Exceptions, 0)) Then
                GoTo NextWorksheet
            End If
        End If
        CurrentValue = Application.Match(hTitle, ws.Rows(hRow), 0)
        If Not IsError(CurrentValue) Then
            i = i + 1
            Data(i, 1) = ws.Name
            Data(i, 2) = CurrentValue
            If CurrentValue > MaxColumn Then
                MaxColumn = CurrentValue
            End If
        End If
NextWorksheet:
    Next ws
                
    ' Insert columns using the values from Data Array..
    For i = 1 To i
        If Data(i, 2) < MaxColumn Then
            wb.Worksheets(Data(i, 1)).Columns(Data(i, 2)) _
              .Resize(, MaxColumn - Data(i, 2)).Insert
        End If
    Next i
    
    ' Inform user.
    MsgBox "Total columns adjusted.", vbInformation, "Success"

End Sub