Question

我坚持将变量范围从一个工作表复制到另一个工作表。我有一个工作簿，其中一个名称是test。它包含a到e列中的数据，事实上，a列中存储了项目的名称，b表示存储c描述中的帐号，e表示帐号的值。关键是，在A列中我有项目名称，然后是填充空单元格的列，B列中是帐号和总和。当下一个项目开始时，它会在列a ....中显示新的项目名称，总共约有2000个条目，分为50个项目。我需要将一个项目的数据只复制到另一个工作表（b和e列），从A1位开始，c1上的下一个项目，依此类推。有人可以帮忙吗？用vba代码吗？对我来说变量太多了......： - ）

Sub CopyCells1()
Dim lRow, x As Integer, y As Integer, z As Integer

lRow = ActiveSheet.Range("A" & Rows.Count).End(xlDown).row
x = 0
z = 1
Do
x = x + 1
If ActiveSheet.Range("A" & x) <> "" Then
        y = x + 1
        If ActiveSheet.Range("A" & y) <> "" Then
        Range(("b" & x), ("b" & y)).Copy
        Sheets("test2").Range(z & 1).PasteSpecial Paste:=xlPasteValues
        Else: y = y + 1
    End If
Else: x = x + 1
End If
Loop Until x = lRow
z = z + 2
End Sub

我尝试的其他代码没有成功......

Sub CopyCells2()
Dim lRow, x As Integer, y As Integer, z As Integer

lRow = ActiveSheet.UsedRange.Rows.Count
For x = 1 To lRow Step 1
y = x + 1
z = 1
If Application.WorksheetFunction.IsText(Range("A" & x)) Or Application.WorksheetFunction.IsNumber(Range("A" & x)) Then

        If Application.WorksheetFunction.IsText(Range("A" & y)) Or Application.WorksheetFunction.IsNumber(Range("A" & y)) Then
        Range(("b" & x), ("b" & y)).Copy
        Sheets("test2").Range(1 & z).PasteSpecial Paste:=xlPasteValues
        Else: y = y + 1
    End If

End If
z = z + 2
Next x

End Sub

解决。
好的，所以这里的代码，如果有人需要它，它应该工作...... ;-) 来自mrexcel.com的Thanx to Koen

Sub CopyData()

Set DataSht = Worksheets("test")
Set ResSht = Worksheets("results")

startrw = 1
endrw = DataSht.Range("B" & Cells.Rows.Count).End(xlUp).Row
rescol = 1

For Rw = startrw To endrw
copy_data = False
If DataSht.Range("A" & Rw).Value <> "" Then
    'New project start
    proj_start_rw = Rw
ElseIf Rw = endrw Then
    'Last row of data, copy last block
    proj_end_rw = Rw
    copy_data = True
ElseIf DataSht.Range("A" & Rw + 1).Value <> "" Then
    'Next row filled, this one empty, copy whole block to the result sheet
    proj_end_rw = Rw
    copy_data = True
Else
    'Empty row, do nothing
End If
If copy_data = True Then
    DataSht.Range("B" & proj_start_rw & ":B" & proj_end_rw).Copy Destination:=ResSht.Cells(1, rescol)
    DataSht.Range("E" & proj_start_rw & ":E" & proj_end_rw).Copy Destination:=ResSht.Cells(1, rescol + 1)
    rescol = rescol + 2
End If
Next Rw

End Sub

Answer 1

以下是我做类似事情的简单示例。我希望它有所帮助

For Each rng In rng2.Cells


If rng.Offset(-1) <> rng Then


        cl = cl + 2
        rw = 1
        sht.Cells(rw, cl) = rng.offset(0,1)
        sht.Cells(rw, cl) = rng.Offset(0, 4)


    Else
        rw = rw + 1
        sht.Cells(rw, cl) = rng.offset(0,1)
        sht.Cells(rw, cl) = rng.Offset(0, 4)


End If
Next

rng2将是您的项目范围。

将变量范围从一个工作表列复制到另一个工作表行

1 个答案: