0

ヘッダー付きの列をワークシートから別の列にコピーしたいと考えています。必要なさまざまなヘッダーを探す配列を作成したので、列全体をコピーして新しいタブに貼り付けることができます。タイプの不一致エラーが発生し、他のタイプも同様に発生する可能性があるため、どこかにエラーがあることはわかっています。誰かが見て、私が見逃している/間違っていることを確認できますか?

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
4

2 に答える 2

0

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という名前のワークシートが、それらの名前の独自のワークシートを挿入するかどうかを尋ねることなく削除されることに注意してください。それを考えると、オリジナルのコピーで実行するのがおそらく最善です。

于 2014-11-23T03:51:41.783 に答える
0

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
于 2014-11-23T06:05:00.660 に答える