如果条件是，则将excel中的行复制到工作表 .

1 回答

• 1

  这不是一个大问题 . 最好的办法是保持简单，并在“全部”改变时复制所有内容 . 我在“全部”工作表上有一个“重新分配”按钮，并有事件调用scatterRows（）

  你没有说出你的源表是什么样的，所以我为表单“all”做了些什么：

  9   0.181626294 carrot  beginner    Irene
  5   0.221180184 beans   advanced    Eva
  8   0.221813735 turnip  advanced    Harry
  10  0.314800867 lettuce homework    John
  4   0.360163255 peas    homework    Doug
  11  0.379956592 pepper  advanced    Karen
  3   0.44415906  tomato  beginner    Charlie
  6   0.647446239 corn    beginner    Frank
  2   0.655706735 potato  advanced    Bob
  7   0.666002258 lentils homework    George
  1   0.768524361 squash  homework    Alice
  

  代码相当灵活;它找到整个源块，所以只要列“D”保存表单键并且数据以A1开始（无 Headers ），您拥有多少列并不重要 . 如果您有 Headers ，请将所有A1引用更改为A2 .

  必须创建其他工作表（“家庭作业”等） . - 并且您需要一个Microsoft Scripting Runtime的引用集 .

  代码中唯一“有趣”的部分是找出目标范围的字符串（putString） .

  Option Explicit
  
  '' Copy rows from the "all" sheet to other sheets
  '' keying the sheetname from column D.
  '' **** Needs Tools|References|Microsoft Scripting Runtime
  '' Changes:
  ''      [1] fixed the putString calculation.
  ''      [2] Added logic to clear the target sheets.
  
  Sub scatterRows()
  
      Dim srcRange As Range
      Dim srcRow As Range
      Dim srcCols As Integer
      Dim srcCat As String
      Dim putRow As Integer
      Dim putString As String
      Dim s                      ''*New [2]
  
      '' Current row for each category
      Dim cats As Dictionary
      Set cats = New Dictionary
      cats.Add "homework", 0
      cats.Add "beginner", 0
      cats.Add "advanced", 0
  
      '' Clear the category sheets  *New [2]
      For Each s In cats.Keys
          Range(s & "!A1").CurrentRegion.Delete
      Next s
  
      '' Find the source range
      Set srcRange = [all!a1].CurrentRegion
      srcCols = srcRange.Columns.Count
  
      '' Move rows from source Loop
      For Each srcRow In srcRange.Rows
  
          '' get the category
          srcCat = srcRow.Cells(4).Value
  
          '' get the target sheet row and increment it
          putRow = cats(srcCat) + 1
          cats(srcCat) = putRow
  
          '' format the target range string     *Fixed [1]
          '' e.g. "homework!A3:E3"
          putString = srcCat & "!" & _
              [a1].Offset(putRow - 1, 0).Address & _
              ":" & [a1].Offset(putRow - 1, srcCols - 1).Address
  
          '' copy from sheet all to target sheet
          Range(putString).Value = srcRow.Value
      Next srcRow
  End Sub
  

  回复于 2024-05-04T07:56:48+08:00