Question

＆＃39;请帮助我将列标题添加到所有工作表中。谢谢！

'SAMPLE CODE FROM THIS SITE
'doesn't add column headers to 3+worksheets

Sub SplitData()

    Dim MyFiles As String
    MyFiles = Dir("C:\Users\jkirby\Desktop\extracted data\*.xlsb")
    Do While MyFiles <> ""
      Workbooks.Open "C:\Users\jkirby\Desktop\extracted data\" & MyFiles

      'deactivate windows security nag
      Application.DisplayAlerts = False

      Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long

      Set Names = Range("F2:F" & Range("a1").End(xlDown).Row)
      n = 0

      For Each name In Names
        If name.Offset(1, 0) <> name Then
            ReDim Preserve DataMarkers(n)
            DataMarkers(n) = name.Row
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
            n = n + 1
        End If
      Next name

      For i = 0 To UBound(DataMarkers)
        If i = 0 Then
            Worksheets(1).Range("A1:ay" & DataMarkers(i)).Copy _
                          Destination:=Worksheets(i + 2).Range("a1")
        Else
            'won't work because it's not copying column headers
            Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & _
                               ":AY" & DataMarkers(i)).Copy _
                    Destination:=Worksheets(i + 2).Range("a1")

        End If
      Next i

      'save as binary (for compression and formatting)
      ActiveWorkbook.saveAs Filename:=Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - 4) & ".xlsb", FileFormat:=xlExcel12

      'reactivate windows security nag
      Application.DisplayAlerts = True

      'close the file we just worked on
      ActiveWorkbook.Close

      'Let's do it again until they are all done
      MyFiles = Dir
    Loop
End Sub

Answer 1

您可能想要更改此内容：

    'won't work because it's not copying column headers
    Worksheets(1).Range("A" & (DataMarkers(i - 1) + 1) & _
                       ":AY" & DataMarkers(i)).Copy _
            Destination:=Worksheets(i + 2).Range("a1")

进入这个：

    'won't work because it's not copying column headers
    Worksheets(1).Range("A" & (DataMarkers(i + 1 - 1) + 1) & _
                       ":AY" & DataMarkers(i)).Copy _
            Destination:=Worksheets(i + 2).Range("a1")

因为在第二个条件下，我可以是1，所以DataMarkers（1-1）返回0，而不是Excel中的列从0开始

此外，我不建议使用名称或名称作为范围或其他变量类型，因为它们是工作表或工作簿范围名称的VBA保留关键字。

干杯，

帕斯卡

http://multiskillz.tekcities.com

VBA通过列值将数据解析为单独的工作表，并在每个工作表上包含列标题

1 个答案: