Question

我想将带有标题的一些列从工作表复制到另一个列。我创建了一个数组来查找所需的不同标头，这样我就可以将整个列复制并粘贴到新标签中。我知道我在某处有错误，因为我遇到类型不匹配错误，也可能是其他类型错误。有人可以看看我错过了什么/有错吗？

Dim rngCell As Range
Dim strHeader() As String
Dim intColumnsMax As Integer

Sheets.Add.Name = "Material Master"
Sheets.Add.Name = "BOM"

intColumnsMax = Sheets("HW Zpure Template").UsedRange.Columns.Count
ReDim strHeader(1 To intColumnsMax)

strHeader(1) = "MATERIAL"
strHeader(2) = "MATERIAL TYPE"
strHeader(3) = "MATERIAL DESCRIPTION"

For Each rngCell In Rows(4)
    For i = 1 To intColumnsMax
        If strHeader(i) = rngCell.Value Then
            rngCell.EntireColumn.Copy
                Sheets("Material Master").Select
                ActiveSheet.Paste Destination:=Worksheets("Material Master").Cells(1, i)
                Sheets("HW Zpure Template").Select
        End If
    Next i
Next

Answer 1

我更喜欢使用Application.Match来查找特定的列标题标签，而不是在尝试查找匹配项时循环使用它们。为此，我大量修改了你的代码。

Dim c As Long, v As Long, vHDRs As Variant
Dim s As Long, vNWSs As Variant, wsMM As Worksheet

vHDRs = Array("MATERIAL", "MATERIAL TYPE", "MATERIAL DESCRIPTION")
vNWSs = Array("Material Master", "BOM")

For v = LBound(vNWSs) To UBound(vNWSs)
    For s = 1 To Sheets.Count
        If Sheets(s).Name = vNWSs(v) Then
            Application.DisplayAlerts = False
            Sheets(s).Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next s
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = vNWSs(v)
Next v

Set wsMM = Sheets("Material Master")
With Sheets("HW Zpure Template")
    For v = LBound(vHDRs) To UBound(vHDRs)
        If CBool(Application.CountIf(.Rows(4), vHDRs(v))) Then
            c = Application.Match(vHDRs(v), .Rows(4), 0)
            Intersect(.UsedRange, .Columns(c)).Copy _
              Destination:=wsMM.Cells(1, Application.CountA(wsMM.Rows(1)) + 1)
        End If
    Next v
End With
Set wsMM = Nothing

如果我错了，请纠正我，但是你的代码似乎正在寻找第4行中的列标签。这就是我在上面使用的但是如果这个假设不正确那么修复应该是不言而喻的。我还将复制的列堆叠到右侧的第一个可用列中。您的代码可能已将它们置于原始位置。

当您运行上述内容时，请注意它将删除名为 Material Master 或 BOM 的工作表，而不会要求插入自己的工作表。鉴于此，最好运行原始副本。

Answer 2

使用Find（）方法是查找所需数据的一种非常有效的方法。以下是优化现有代码的一些建议。

Dim rngCell As Range
Dim strHeader() As String
Dim intColumnsMax As Integer
Dim i As Integer

Sheets.Add.Name = "Material Master"
Sheets.Add.Name = "BOM"

'Quick way to load a string array
'This example splits a comma delimited string.
'If your headers contain commas, replace the commas in the next line of code
'with a character that does not exist in the headers.
strHeader = Split("MATERIAL,MATERIAL TYPE,MATERIAL DESCRIPTION", ",")

'Only loop through the headers needed
For i = LBound(strHeader) To UBound(strHeader)
    Set rngCell = Sheets("HW Zpure Template").UsedRange.Find(What:=strheader(i), LookAt:=xlWhole)
    If Not rngCell Is Nothing Then

        'Taking the intersection of the used range and the entire desired column avoids
        'copying a lot of unnecessary cells.
        Set rngCell = Intersect(Sheets("HW Zpure Template").UsedRange, rngCell.EntireColumn)

        'This method is more memory consuming, but necessary if you need to copy all formatting
        rngCell.Copy Destination:=Worksheets("Material Master").Range(rngCell.Address)

        'This method is the most efficient if you only need to copy the values
        Worksheets("Material Master").Range(rngCell.Address).Value = rngCell.Value
    End If
Next i

将工作表中的特定列复制/粘贴到另一个列

2 个答案: