Question

我想根据工作簿中已存在的选项卡名称拆分一些数据。

例如，我有一个工作表，其中包含多个交易的帐号列表。在此旁边，我有一个空白的帐号的工作表。而不是每次我想创建宏时复制和粘贴匹配的记录。

我找到了下面的代码，但这实际上创建了多个标签。我对VBA很新。有没有办法调整此代码不创建选项卡..只是填充它们。

非常感谢。

__dict__

End Sub

Answer 1

如果没有您要尝试排序的数据的示例或解释，那将非常困难，但基本似乎是您在Sheet 1中按行排序的数据，您希望将其拆分为其他几个工作表关于该数据的价值。

下面是一个如何实现这一目标的简单示例，但您必须采用您要对其进行排序的特定数据和规则。

Sub Sort_Data(Has_Header As Boolean)
  Dim Ws As Worksheet, New_Sht As Worksheet
  Dim X As Integer, Cur_Row As Integer, Start_Row As Integer
  Dim Shts() As Integer
  ReDim Shts(1 to (Sheets.Count-1)) As Integer
  For X = 1 to (Sheets.Count-1))
    Shts(X) = 1
    If Has_Header = True the Shts(X) = 2
  Next X
  Set Ws = Sheets(1)
  Start_Row = 1
  If Has_Header = True then Start_Row = 2
  For Cur_Row = Start_Row to Ws.Rows.Count
    If Ws.Range("A1").Value = "" Then Exit For 'This checks for an empty row and quits the process once reaching one.
    X = 0
    Select Case Ws.Range(Cells(Cur_Row, 2).Address).Value 'This assumes the data you wish to sort by is in Column B (2).
      Case "Value 1":
        X = 2
      Case "Value 2":
        X = 3
      Case "Value 3":
        X = 4
    End Select
    If X <> 0 Then
      Set New_Sht = Sheets(X)
      Ws.Sheets.Range("A" & Cur_Row).EntireRow.Copy
      New_Sht.Range("A" & Shts(X-1)).PasteSpecial xlPasteAll
      Shts(X-1) = Shts(X-1) + 1
    End If
  Next Cur_Row
End Sub

将数据拆分为已存在的多个选项卡

1 个答案: