VBA Excel 宏代码从另一个工作表中删除列

Question

我需要一个分析数组内部信息的程序。有 2 个工作表，“CleanDATA”和“iTOAcolumns”，在 iTOAcolumns 中有一个包含 3 列的表：我们如何命名列、字母（A、B、C...、AF、AG 等）和“保留”列可以为空或带有 X（意味着我们需要保留该项目）。该数组从 iTOAcolumns 中的表获取信息，确定删除“CleanDATA”中的哪些列（附图）。运行宏时，空白列将被删除（从 CleanDATA 工作表中）并移至左侧，以确保列之间不留空格。我想使用数组，因为我不想再在工作表之间移动。

这是我的代码

Sub Macro6()

' Macro6 Macro

Dim DirArray As Variant
Dim curCOL As String
Dim i As Integer
Dim targetSheet As Worksheet

' Set target sheet
Set targetSheet = Sheets("iTOAcolumns")  ' Replace with your actual sheet name if different

DirArray = targetSheet.Range("KEEPcols").Value  ' Get values from KEEPcols in iTOAcolumns sheet

' Loop through each element in the DirArray
For i = LBound(DirArray, 1) To UBound(DirArray, 1) Step 1

    curCOL = DirArray(i, 1)  ' Get the column letter from the array

    ' Check if the column exists
    If Columns(curCOL).Count > 0 Then

        ' Go to the cell below in column D (assuming criteria)
        targetSheet.Cells(i + 1, 4).Select  ' Select the cell for checking

        ' Check if the cell to the right is empty
        If ActiveCell.Offset(0, 1).Value = "" Then

            ' Delete the column using the column letter from the array
            Columns(curCOL).EntireColumn.Delete Shift:=xlToLeft
        End If
    End If

Next i


End Sub

我面临的问题是，当使用 F8 查看代码时，宏确实会遍历列表，但不会删除任何所需的列。我不知道边界是否不正确或者循环是否不正确。另外，值得一提的是，iTOA 列列表按升序排列，首先是 AJ、AI、AH...，然后是 C、B、A，最后。帮助PPPPP

Answer 1

您可以使用

Match

和列标题：

Sub Macro6()

    Dim i As Long, DirArray As Variant
    Dim infoSheet As Worksheet, dataSheet As Worksheet, m
    
    Set dataSheet = ActiveSheet 'or specific named sheet
    Set infoSheet = ThisWorkbook.Worksheets("iTOAcolumns")
    'read all 3 columns to an array: adjust range as needed...
    DirArray = infoSheet.Range("A2:C" & infoSheet.Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    For i = LBound(DirArray, 1) To UBound(DirArray, 1)
        If Len(DirArray(i, 3)) = 0 Then 'remove this col?
            m = Application.Match(DirArray(i, 1), dataSheet.Rows(1), 0) 'try to match col header
            If Not IsError(m) Then  'if no match then m will be an error value
                dataSheet.Columns(m).Delete
            End If   'matched header
        End If       'a column to delete
    Next i
End Sub