时间戳

首页 > 解决方案 > 在循环中复制范围内的非空白行

excel - 在循环中复制范围内的非空白行

问题描述

我的桌子是这样的；

一个标题 另一个标题
第一的 排
第二 排
第一的 排
第二 排

[这里，空白行有“”。]

我想要一个这样的表（值）；

一个标题 另一个标题
第一的 排
第二 排
第一的 排
第二 排

我编写了代码来复制并粘贴为新单元格的值。

Dim i As Long
Dim Rng As Range
'for the first table
ActiveSheet.Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ThisWorkbook.Sheets("Sheet1").Range("S3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Set Rng = ActiveSheet.Range("S3")
'Remove "" values that comes from formula

For i = 1 To 600
    If Rng.Cells(i, 1) = "" Then
       Rng.Cells(i, 1).ClearContents
    End If
Next i
'For the second formula
ActiveSheet.Range("A18").Select
Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ThisWorkbook.Sheets("Sheet1").Range("S3").Select
    ThisWorkbook.Sheets("Sheet1").Range("S3").End(xlDown).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set Rng = ActiveSheet.Range("S3")

    For i = 1 To 600
        If Rng.Cells(i, 1) = "" Then
           Rng.Cells(i, 1).ClearContents
        End If
    Next i
'It continues till 39 table....

我必须为每个数据组粘贴代码。我有一张很长的桌子，所以我想把它做成一个循环。

标签： excelvbaloops

解决方案

我自己弄清楚我不知道在清除“”单元格时循环多个表以复制和粘贴是否是一个常见问题，但这是我的代码，也许将来有人会需要它；

Sub test()
Dim j As Long

Dim i As Long
Dim Rng As Range
Set Rng = ActiveSheet.Range("S3")


    ActiveSheet.Cells(3, 1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ThisWorkbook.Sheets("test").Range("S3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    

    For i = 1 To 600
      If Rng.Cells(i, 1) = "" Then
         Rng.Cells(i, 1).ClearContents
      End If
    Next i

For j = 0 To 525 Step 15

    ActiveSheet.Cells(18 + j, 1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ThisWorkbook.Sheets("test").Range("S3").Select
    ThisWorkbook.Sheets("test").Range("S3").End(xlDown).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set Rng = ActiveSheet.Range("S3")

    For i = 1 To 600
        If Rng.Cells(i, 1) = "" Then
           Rng.Cells(i, 1).ClearContents
        End If
    Next i
Next j


End Sub

推荐阅读