Question

我正在尝试使用VBA实现以下目标：

我有两张纸：“收入”和“营业税”，它们记录了从5月1日到5月28日的100家商店的收入和营业税。现在，我正在尝试为每个商店创建一个表格，记录其5月1日至5月28日的收入和营业税。

Sub test1()


    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy Before:=Sheets(17)

    Sheets("revenue").Select
    Range("D154:D168").Select
    Selection.Copy

    Sheets("Sheet1 (2)").Select
    Range("C5").Select
    ActiveSheet.Paste

    Sheets("sales tax").Select
    Range("D138:D152").Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("Sheet1 (2)").Select
    Range("F5").Select
    ActiveSheet.Paste

    Sheets("Sheet1 (2)").Select
    Sheets("Sheet1 (2)").Name = " reportF "

End Sub

使用此代码，我每次只能为1个商店建立一个文件。我应该使用哪种循环语法遍历所有商店？

Answer 1

您的数据似乎在D列中有商店名称？此代码将D列中的所有单元格向下运行，并根据内容将它们复制到单独的工作表中

    Sub ExampleCode
    Dim r as range  'declare a pointer variable
    Dim ws as worksheet  'declare a worksheet variable
    set r = Range("d1")  'point to fist cell
    Do   'Start a loop
       If SheetNotExist(r.text) then  'if no sheet of that name
          set ws = worksheets.add(after:=worksheets.count)  'add one
          ws.name = r.text        'and name it as text in r
       End if
       r.copy worksheets(r.text).cells(rows.count,4).end(xlup).offset(1,0)  'copy to next blank cell
       set r = r.offset(1,0) 'shift pointer down one cell
    Loop until r.text = ""  'keep going until r is empty
    End Sub


   Function SheetNotExist(s as string) as boolean  'check if sheet exists
   On error goto nope  'jump on error
   Dim ws as worksheet
   set ws = worksheets(s)  'this will error if sheet doesn't exist
  'so if we get here the sheet does exist
   SheetNotExist = False 'so return false
   Exit Function 'and go back
   nope:  'we only get here if sheet doesn't exist
   SheetNotExist = True 'so return that
   End Function

用我的手机写的-没有excel，所以可能会有错别字-因此代码可能无法编译，

如何将一张工作表中的每一列迭代复制到不同的工作表

1 个答案: