VBA - 选择数据

时间：2014-03-19 21:47:46

标签： excel vba excel-vba

我完全是VBA的新手，但花了大约一个星期来修补它。我正在尝试通过记录和搞乱互联网搜索的代码以及我对VBA的有限研究，在excel中自动执行相当密集的任务。我实际上已经深入了解这个过程，但我遇到了一个我似乎无法找到相关信息的问题。我认为这是一个常见的问题，所以可能已经存在其中的东西，我只是没有输入神奇的单词组合来搜索正确的答案。

我的问题是：我有一个包含大约10,000行数据的工作表，根据这些原始数据，我需要为60个不同的公司创建60个左右的独立电子表格 - 所以大约160个行实际上属于给定的客户端。但是，它没有固定，从一个月到下一个月，实际行数发生了变化，所以我不能只使用一个简单的范围。有两种方法可以标记数据与新客户端相关。在第1列中，如果单元格显示为null，则表示新客户端数据的开始。或者，第2列包含客户端的名称，因此如果b列中的单元格不等于正上方的单元格，则它也将标记新客户端数据的开头。

关键是我需要选择并剪切每个客户端的所有数据并将其粘贴到新打开的工作簿中。

我已经研究了几种方法来做这个，现在正在研究循环和循环。任何人都可以建议一个可能的结构来做这个或一个可能有帮助的资源？

更新代码：

Sub copyStuff()


Dim rowStart As Integer
Dim rowEnd As Integer
Dim rowMax As Integer
Dim colMax As Integer
Dim bookName As String

Dim thisWB As String
thisWB = ThisWorkbook.Name


rowMax = ActiveSheet.UsedRange.Rows.Count + 1
colMax = ActiveSheet.UsedRange.Columns.Count
rowStart = 2
For x = 3 To rowMax
    If Cells(x, 2) = Cells(x - 1, 2) Then
        '
    Else
        rowEnd = x - 1

        Range(Cells(rowStart, 1), Cells(rowEnd, colMax)).Copy
        Set NewBook = Workbooks.Add
        Range("A2").PasteSpecial (xlPasteValues)
        bookName = Cells(rowStart, 2).Value


        NewBook.SaveAs Filename:=bookName

        Workbooks(thisWB).Activate
        Range(Cells(1, 1), Cells(1, colMax)).Copy

        Workbooks(bookName).Activate
        Range("A1").PasteSpecial (xlPasteValues)
        ActiveSheet.Name = "Daily Summary"


        ActiveWorkbook.Save
        Workbooks(thisWB).Activate
        Worksheets("transaction details").Activate








    If Cells(x, 2) = Cells(x - 1, 2) Then
        '
    Else
        rowEnd = x - 1

        Range(Cells(rowStart, 1), Cells(rowEnd, colMax)).Copy
        NewBook.Activate
        Range("A2").PasteSpecial (xlPasteValues)
        Sheets.Add.Name = "Transaction Details"


                Workbooks(thisWB).Worksheet("Transaction Details").Activate
        Range(Cells(1, 1), Cells(1, colMax)).Copy

        Workbooks(bookName).Activate
        Range("A1").PasteSpecial (xlPasteValues)
        End If

        Workbooks(bookName).Activate

        Worksheets("Daily Summary").Activate




        Columns("B").Delete
          Range("A1:O1").Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A30:O30").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.Bold = True
    Range("C2:O29").Select
    Range("C29").Activate
    Selection.Style = "Currency"
    Columns("A:A").Select
    Selection.NumberFormat = "m/d/yyyy"
    ActiveCell.Replace What:="Null", Replacement:="Total", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("D22").Select
     Cells.Select
    Cells.EntireColumn.AutoFit






      ActiveWorkbook.Sheets.Add.Name = "Summary"
    ActiveWorkbook.Worksheets("Summary").Activate
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Description"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "=EOMONTH(TODAY(),-2)+1"
    Selection.NumberFormat = "m/d/yyyy"
    Range("A1:B1").Select

     Range("A1:B1").Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin

    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B1").Select
    CellContentCanBeInterpretedAsADate = True
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Total Amex Charges"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Total Visa Charges"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Total MasterCard Charges"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "Total Discover Charges"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "Total Credit Card Charges"
    Range("A6:B6").Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "Amex Transaction Fee (.05/per)"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "MasterCard Card Fees"
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "Visa Card Fees"
    Range("A11").Select
    ActiveCell.FormulaR1C1 = "Discover Fees"
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "Total Card Fees"
    Range("A12:B12").Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A14").Select
    ActiveCell.FormulaR1C1 = "xx Management Fee"
    Range("A15").Select
    ActiveCell.FormulaR1C1 = "Total xx Fees"
    Range("A15:B15").Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A17").Select
    ActiveCell.FormulaR1C1 = "Equipment Payment Fee"
    Range("A18").Select
    ActiveCell.FormulaR1C1 = "Total Equipment Fees"
    Range("A18:B18").Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A20").Select
    ActiveCell.FormulaR1C1 = "Total Visa, MasterCard, Discover Charges"
    Range("A21").Select
    ActiveCell.FormulaR1C1 = "Less: Total Fees"
    Range("A22").Select
    ActiveCell.FormulaR1C1 = "Total Amount Owed"
    Range("A23").Select
    ActiveCell.FormulaR1C1 = "Total ACH Payments"
    Range("A24").Select
    ActiveCell.FormulaR1C1 = "Overpaid (UnderPaid)"
    Range("A24:B24").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A22:B22").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A20:B20").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A20:B20,A22:B22,A24:B24").Select
    Range("A24").Activate
    Selection.Font.Bold = True
    Cells.Select
    Cells.EntireColumn.AutoFit

    Range("B2:B24").Select
    Selection.Style = "Currency"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 2).Value
    Range("B3").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 4).Value
    Range("B4").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 5).Value
    Range("B5").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 3).Value
    Range("B6").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 6).Value

    Sheets("Daily Summary").Select
    Columns("G:G").Select
    Selection.Cut
    Columns("O:O").Select
    Selection.Insert Shift:=xlToRight

    Sheets("Summary").Select
    Range("B8").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 10).Value
    Range("B9").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 7).Value
    Range("B10").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 8).Value
    Range("B11").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 9).Value
    Range("B12").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 11).Value
    Range("B14").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 12).Value
    Range("B15").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C"
    Range("B17").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 13).Value
    Range("B18").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C"
    Range("B20").Select
    ActiveCell.FormulaR1C1 = "=R[-17]C+R[-16]C+R[-15]C"
    Range("B21").Select
    ActiveCell.FormulaR1C1 = "=R[-9]C+R[-6]C+R[-3]C"
    Range("B22").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"
    Range("B22").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"
    Range("B21").Select
    ActiveCell.FormulaR1C1 = "=R[-9]C+R[-6]C+R[-3]C"
    Range("B23").Select
    ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 16).Value
    Range("B24").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"
    Range("B25").Select

        ActiveWorkbook.Close

        rowStart = x
        Sheets("Data").Activate


    End If
Next

End Sub

1 个答案:

答案 0 :(得分：1)

这就是我认为你正在寻找的东西。这将循环（当前）列A并查找单元格是否与其上方的单元格相同。如果是，它将跳到下一行并继续查看。

当遇到单元格更改时，它将从范围的开头复制到结尾并将其粘贴到新工作簿中。无论细胞价值是多少，它目前都会为这本书命名。理论上，它将它命名为公司名称。

Sub copyStuff()


Dim rowStart As Integer
Dim rowEnd As Integer
Dim rowMax As Integer
Dim colMax As Integer
Dim bookName As String

Dim thisWB As String
thisWB = ThisWorkbook.Name


rowMax = ActiveSheet.UsedRange.Rows.Count + 1
colMax = ActiveSheet.UsedRange.Columns.Count
rowStart = 2
For x = 3 To rowMax
    If Cells(x, 1) = Cells(x - 1, 1) Then
        '
    Else
        rowEnd = x - 1
        bookName = Cells(rowEnd, 1).Value
        Range(Cells(rowStart, 1), Cells(rowEnd, colMax)).Copy
        Set NewBook = Workbooks.Add
        Range("A2").PasteSpecial (xlPasteValues)


        NewBook.SaveAs Filename:=bookName

        Workbooks(thisWB).Activate
        Range(Cells(1, 1), Cells(1, colMax)).Copy

        Workbooks(bookName).Activate
        Range("A1").PasteSpecial (xlPasteValues)


        ActiveWorkbook.Save
        ActiveWorkbook.Close

        rowStart = x
        Sheets("Data").Activate


    End If
Next

End Sub
相关问题
最新问题