Question

我试图在以下宏之后清除工作表的内容。我尝试使用Sheets（“ Sheet1”）。UsedRange.ClearContents，但似乎清除了两个工作表。我觉得这与Do ... Until循环有关，尽管在Loop后面放置了清晰的线条。这是我编写的第一个宏，因此仍在学习所有注释。

Sub LookUpTable()

'Declare Variables'

Dim rngB As Range
Dim Rng As Range
Dim sh As Worksheet
Dim iCountComma
Dim VarArr As Variant
Dim i As Long

'Separate Cell C2 into Column C by Comma'

Set sh = Sheets("Sheet1")
Set rngB = sh.Range("C2")
For Each Rng In rngB
    If InStr(Rng, ",") > 0 Then
    iCountComma = Len(Rng) - Len(Replace(Rng, ",", ""))
    VarArr = Split(Rng, ",")
    For i = 0 To iCountComma
        Rng.Offset(i) = Trim(VarArr(i))
    Next
End If
Next

'I Don't really know what these do'

Application.CutCopyMode = True
Application.ScreenUpdating = True


'Declare Variables'

Dim BedPre As String
Dim BedSuf As String
Dim HISPre As String
Dim HISSuf As String
Dim ID As String
Dim Bed As String
Dim HIS As String
Dim NextRow As Long

'Assign cell values to variables'

BedPre = Range("A2").Value
BedSuf = Range("B2").Value
HISPre = Range("D2").Value
HISSuf = Range("E2").Value
ID = Range("F2").Value

'Select Cell C2'

Sheets("Sheet1").Select
Range("C2").Select

'Loop until empty value in Column C'

Do Until ActiveCell.Value = ""

'Find last empty cell in sheet 2'

NextRow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0).Row

'Concantenate cells and append Sheet 2'

Bed = BedPre & ActiveCell & BedSuf
HIS = HISPre & ActiveCell & HISSuf
Sheets("Sheet2").Cells(NextRow, 1) = Bed
Sheets("Sheet2").Cells(NextRow, 2) = HIS
Sheets("Sheet2").Cells(NextRow, 3) = ID
ActiveCell.Offset(1, 0).Select

Loop

Sheets("Sheet1").UsedRange.ClearContents
End Sub

Answer 1

我看不到数据清除两个工作表。您可以使用此代码

Sub LookUpTable()

'Declare Variables'

Dim Rng As Range
Dim VarArr As Variant
Dim i As Long

Dim BedPre As String
Dim BedSuf As String
Dim HISPre As String
Dim HISSuf As String
Dim ID As String
Dim Bed As String
Dim HIS As String
Dim NextRow As Long

'Assign cell values to variables'
With Sheets("Sheet1")
    BedPre = Range("A2").Value
    BedSuf = Range("B2").Value
    HISPre = Range("D2").Value
    HISSuf = Range("E2").Value
    ID = Range("F2").Value
    Set Rng = .Range("C2")
End With
NextRow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0).Row
If InStr(Rng, ",") > 0 Then
    VarArr = Split(Rng, ",")
    For i = 0 To UBound(VarArr)
        Bed = BedPre & Trim(VarArr(i)) & BedSuf
        HIS = HISPre & Trim(VarArr(i)) & HISSuf
        NextRow = NextRow + 1
        Sheets("Sheet2").Cells(NextRow, 1) = Bed
        Sheets("Sheet2").Cells(NextRow, 2) = HIS
        Sheets("Sheet2").Cells(NextRow, 3) = ID
    Next
End If
Sheets("Sheet1").Range("A2:F2").ClearContents
End Sub

如何只清除一个工作表？

1 个答案: