Excel 使用VBA宏为每行添加5行

大家好，我有两个工作表，从Sheet1复制到Sheet2，将数据复制到每行一次，现在我希望我的数据看起来像“待版本”： 第一列将重复5次，另一列应该只重复一次，但它不起作用

我正在使用宏来执行此操作

    Function getLastRow(targetSheet As Worksheet, colLetter As String) As Integer
        Dim lastRow As Integer
        With targetSheet
            getLastRow = .Cells(.Rows.count, colLetter).End(xlUp).Row
        End With
    End Function
    
    Function getColumn(targetSheet As Worksheet, FindWord As String, Optional iRow As Integer = 1) As Integer
        Dim iCol As Integer
        Dim tmpString As String
        For iCol = 1 To getLastColumn(targetSheet, 2)
            'targetSheet.Activate
            tmpString = VBA.Replace(targetSheet.Cells(iRow, iCol).Value, "", "")
            If VBA.InStr(1, VBA.LCase(tmpString), VBA.Replace(VBA.LCase(FindWord), "", "")) Then
                getColumn = iCol
                Exit Function
            End If
        Next iCol
        
    End Function
    
Sub ProcFile()
Dim wsRaw As Worksheet: Set wsRaw = ThisWorkbook.Sheets("Sheet1")
Dim wsAR As Worksheet: Set wsAR = ThisWorkbook.Sheets("Sheet2")
Dim iRow, x, LRow, sRow, col As Long
Dim Tes1, Test2, Test3 As String

sRow = getLastRow(wsAR, "E") + 1
LRow = getLastRow(wsRaw, "A")

If wsRaw.Range("A2").Value = "" Then MsgBox "Raw Data tab is Empty!!", vbCritical: Exit Sub

For x = 2 To LRow
        
        Tes1 = wsRaw.Cells(x, getColumn(wsRaw, "Tes1")).Value
        Test2 = wsRaw.Cells(x, getColumn(wsRaw, "Test2")).Value
        Test3 = wsRaw.Cells(x, getColumn(wsRaw, "Test3")).Value
        
       
        
            For col = 3 To 45 Step 2
                If wsRaw.Cells(x, col).Value <> "" Then

                    wsAR.Range("A" & sRow).Value = Tes1
                    wsAR.Range("B" & sRow).Value = Test2
                    wsAR.Range("C" & sRow).Value = Test3
        
                    
                    
                    End If
               
                
                
            Next col
           sRow = sRow + 1
        
Next x

MsgBox "Done!!"

End Sub

函数getLastRow（targetSheet作为工作表，colLetter作为字符串）作为整数
将最后一行设置为整数
有目标表
getLastRow=.Cells（.Rows.count，colLetter）.End（xlUp）.Row
以
端函数
函数getColumn（targetSheet作为工作表，FindWord作为字符串，可选iRow作为整数=1）作为整数
作为整数的Dim-iCol
将tmpString设置为字符串
对于iCol=1到getLastColumn（targetSheet，2）
'targetSheet.Activate
tmpString=VBA.Replace（targetSheet.Cells（iRow，iCol）.Value，“”，“”）
如果VBA.InStr（1，VBA.LCase（tmpString），VBA.Replace（VBA.LCase（FindWord），“”，“”），则
getColumn=iCol
退出功能
如果结束
下一个iCol
端函数
子文件（）
将wsRaw设置为工作表：设置wsRaw=ThisWorkbook.Sheets（“Sheet1”）
将wsAR设置为工作表：设置wsAR=ThisWorkbook.Sheets（“Sheet2”）
暗箭头、x、LRow、sRow、col等长
尺寸Tes1、TES2、TES3为字符串
sRow=getLastRow（wsAR，“E”）+1
LRow=getLastRow（wsRaw，“A”）
如果wsRaw.Range（“A2”）.Value=”“，则MsgBox“原始数据选项卡为空！！”，vbCritical:Exit Sub
对于x=2至LRow
Tes1=wsRaw.Cells（x，getColumn（wsRaw，“Tes1”））.Value
Test2=wsRaw.Cells（x，getColumn（wsRaw，“Test2”））.Value
Test3=wsRaw.Cells（x，getColumn（wsRaw，“Test3”））.Value
对于col=3至45，第2步
如果wsRaw.Cells（x，col）.Value为“”，则
wsAR.Range（“A”&sRow）.Value=Tes1
wsAR.Range（“B”和sRow）.Value=Test2
wsAR.Range（“C”和sRow）.Value=Test3
如果结束
下一列
sRow=sRow+1
下一个x
MsgBox“完成！！”
端接头

表1原始数据

表2宏执行后的数据输入

我在宏执行中获得的数据：

重复行 快速帮助（未经测试）

更换线路

sRow = sRow + 1

与

而不是台词：

wsAR.Range("A" & sRow).Value = Tes1
wsAR.Range("B" & sRow).Value = Test2
wsAR.Range("C" & sRow).Value = Test3

使用以下命令：

wsAR.Range("B" & sRow).Value = Test2
wsAR.Range("C" & sRow).Value = Test3
For sRow = sRow To sRow + 4
    wsAR.Range("A" & sRow).Value = Test1
Next sRow
sRow = sRow - 5

初始答案

• 以下内容将以以下方式覆盖某个范围：
  • 第一行（标题）保持不变
  • 第一列中的每个值将被写五次，一次写在另一列的下面
  • 剩下的列只写一次，下面留下四个空单元格

选项显式
子行（）
Const wsName As String=“Sheet2”
Const ROWSCONT长度=4
将wb设置为工作簿：设置wb=ThisWorkbook包含此代码的工作簿
将rg设置为范围：设置rg=wb.Worksheets（wsName）.Range（“A1”）.CurrentRegion
尺寸数据作为变量：数据=rg.值
长度为的Dim srCount:srCount=UBound（数据，1）
长度为的Dim cCount:cCount=UBound（数据，2）
长度为的Dim drCount:drCount=（srCount-1）*（ROWSCONT+1）+1
变码结果：重拨结果（1到drCount，1到cCount）
尺寸c与长度相同
对于c=1的情况，应计算
结果（1，c）=数据（1，c）
下一个c
尺寸n与长度：n=1
暗r一样长，我一样长
对于r=2到srCount
n=n+1
对于c=1的情况，应计算
结果（n，c）=数据（r，c）
下一个c
对于i=1至RowsCount
n=n+1
结果（n，1）=数据（r，1）
接下来我
下一个r
rg.Resize（n）.Value=结果
端接头

如果我执行Srow=Srow+5，它可以工作，但只会在重复第一列5次时遇到麻烦。感谢我可以对代码进行任何修改以使其工作？太难了。如果您可以发布整个代码，以及

wsRaw

的屏幕截图，以及所需的

wsAr

，我可以更正我的代码，或许可以编写一个更合适的版本。我发布了我正在Button上执行的代码click@I我在回答的开头添加了一个快速修复。

wsAR.Range("B" & sRow).Value = Test2
wsAR.Range("C" & sRow).Value = Test3
For sRow = sRow To sRow + 4
    wsAR.Range("A" & sRow).Value = Test1
Next sRow
sRow = sRow - 5