时间戳

首页 > 解决方案 > 迭代一列并在多个工作表中设置值

excel - 迭代一列并在多个工作表中设置值

问题描述

我是一个编程新手，所以请多多包涵。

我目前有一个工作表，Sheet1“DataSheet”，在 A、B 和 C 列中未定义数量的行上保存字符串（文本）数据。Sheet2“BlankSheet”是一个模板“记分卡”，我必须根据总数无限期地复制它“DataSheet”中的数据输入行。我使用命令按钮做到了这一点。

Sub Button2_Click()
    Dim i As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xActiveSheet = ThisWorkbook.Worksheets("BlankSheet")
    xNumber = Range("J2")
    For i = 1 To xNumber
        xName = ActiveSheet.Name
        xActiveSheet.Copy after:=ActiveWorkbook.Sheets(xName)
        ActiveSheet.Name = "Individual Score Sheet" & i
    Next
    xActiveSheet.Activate
    Application.ScreenUpdating = True
    CommandButton1.Enabled = False
End Sub

创建适当数量的计分表后，我需要将 A、B 和 C 列的“数据表”中的个人数据导出到每个计分卡。

前任：

  1. “DataSheet”单元格 A2 需要转到“Individual Score Sheet1”范围 A6:E6（合并单元格），“DataSheet”单元格 B2 到“Individual Score Sheet1”范围 F6:I6（合并单元格）和“DataSheet”单元格 C2 到个人评分表 1" 范围 J6:N6（合并单元格）

  2. “DataSheet”单元格 A3 需要转到“Individual Score Sheet2”范围 A6:E6（合并单元格），“DataSheet”单元格 B3 到“Individual Score Sheet2”范围 F6:I6（合并单元格）和“DataSheet”单元格 C3 到个人评分表 2" 范围 J6:N6（合并单元格）

等等，等等。直到行为空白。

到目前为止，我有：

Sub Button3_Click()

    Dim ws As Worksheet
    Application.ScreenUpdating = False
    
    With Sheet1
    
        For Each r In .Range("A1", .Range("A1").End(xlDown))
        
            For Each ws In Sheets
        
                Select Case ws.Name
                    Case "DataSheet", "BlankSheet"
                
                    Case Else

                    ws.Select
                    ws.Range("A6") = r
                
                End Select
                
            Next ws
                
        Next r
        
    End With

    Application.ScreenUpdating = True

End Sub

该程序准确地忽略“DataSheet”和“BlankSheet”，向下迭代A列中的数据并在没有数据时结束，并遍历其他工作表，但是它只将每个工作表的值设置为数据的最终迭代A 列。

我还没有尝试让 B 列或 C 列工作。目标是自动生成“x”数量的“记分卡”以进行打印。

当它沿 A、B 和 C 列中的行向下工作时，我如何对其进行修改以将数据迭代到“个人评分表#”工作表中？

是否可以将这两个按钮组合成一个命令？

提前致谢！

标签： excelvbaloops

解决方案

这段代码应该在一个子程序中完成所有事情，并且可以从一个单独的按钮调用。

Option Explicit

Sub Button2_Click()
Dim wsData As Worksheet
Dim wsScore As Worksheet
Dim wsTemp As Worksheet
Dim rngSrc As Range
Dim idx As Long

    Application.ScreenUpdating = False
    
    Set wsData = ThisWorkbook.Sheets("DataSheet")
    Set rngSrc = wsData.Range("A2")
    
    Set wsTemp = ThisWorkbook.Worksheets("BlankSheet")
    
    Do
        wsTemp.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Set wsScore = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        idx = idx + 1
        With wsScore
            .Name = "Individual Score Sheet" & idx
            rngSrc.Copy .Range("A6:E6")
            rngSrc.Offset(, 1).Copy .Range("F6:I6")
            rngSrc.Offset(, 2).Copy .Range("J6:N6")
        End With
        
        Set rngSrc = rngSrc.Offset(1)
    Loop Until rngSrc.Value = ""
   
    Application.ScreenUpdating = True
    
    CommandButton1.Enabled = False
    
End Sub

推荐阅读