0

我想将一些列数据导出到单独的工作表中，然后将其导出到单独的 ASCII 文本文件中。具体数据如图所示，我想将前两列（x，y 坐标）和之后的每一列复制到自己的工作表中。

 x     y    Comp1   Comp2   Comp3   Comp4    …  Comp23
-40  -20    55.29   0       0       73       …  105.67
-40  -19.9  56.79   0       33      72       …  112.5
-40  -19.8  69.29   0       31      89       …  114
-40  -19.7  70.29   0       58.14   108      …  125
 …    …     …       …       …       …        …  …
 40   55    72.29   0       49      117      …  132

我仍然在掌握编写宏，所以现在我基本上是在尝试为其中一次迭代调整录制的宏以适用于整个工作表，如下所示：

Sub CopyColData()
    ActiveCell.Range("A1:B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Comp1"
    Sheets("SUM").Select
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Comp1").Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveSheet.Paste
End Sub

理想情况下，我希望它为前两列中的坐标数据为每一列创建一个新工作表，根据列标题标记工作表，然后将列数据复制到第三列。之后，我将使用不同的宏将多张工作表导出到单独的 ASCII 文件中。谢谢！

4

1 回答 1

0

All thanks to Jerry Beaucaire (again!) but I added a counter for sheet naming: 

Option Explicit

Sub ColumnsToSheets()
'Author:    Jerry Beaucaire
'Date:      8/7/2011
'Summary:   Create separate sheets from the columns of a data sheet

Dim wsData   As Worksheet   'Sheet with data to parse
Dim FirstCol As Long        'This is the first column to transfer
Dim ColCnt   As Long        'This is how many columns in a group to transfer
Dim LastCol  As Long        'check row1 to see how many columns of data there are
Dim NewSht   As Long        'how many new sheets will be created
Dim inti As Integer         'counter for sheet naming

FirstCol = Application.InputBox("Which column is the first 'data column' to transfer?" _
    & vbLf & "(A=1, B=2, C=3, etc...)" _
    & vbLf & "(All columns to the left will appear on every sheet)", _
    "First Data Column", 2, Type:=1)
If FirstCol = 0 Then Exit Sub

ColCnt = Application.InputBox("How many data columns are in each group?", _
    "Groups of Columns", 1, Type:=1)
If ColCnt = 0 Then Exit Sub
inti = 1
Set wsData = ActiveWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False

  With wsData
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For NewSht = FirstCol To LastCol Step ColCnt
        Sheets.Add , After:=Sheets(Sheets.Count)
        .Columns(1).Resize(, FirstCol - 1).Copy Range("A1")
        .Columns(NewSht).Resize(, ColCnt).Copy Cells(1, FirstCol)
        ActiveSheet.Name = "Comp" & inti
        inti = inti + 1
    Next NewSht
  End With
Application.ScreenUpdating = True
End Sub
于 2013-08-13T00:39:24.683 回答