Question

我有一个VBA宏，它当前正在从设置表中复制数据，并且第一次更新到相应的表中的Read_Only表。但是当我第二次点击时，它会将数据添加到Read_Only表中的各个表中。

现在我想要的是，如果我第二次点击，它应首先清除Read_Only表中相应表中的现有数据，然后将新数据更新到该表中。（例如：在第1个表中，有10行数据，现在当我点击第2次时我只有8行数据时，宏应该清除现有10行数据的数据并更新这8行新数据然后删除这两个空的两行。这应该是动态的，因为在更新新数据时每行的行数可能会有所不同）

以下是现有代码：

Sub copyData()

    Dim wsSet As Worksheet
    Dim wsRead As Worksheet
    Dim rngSearch As Range
    Dim lastRow As Integer
    Dim i As Integer
    Dim wRow As Integer
    Dim strCat As String
    Dim catRow As Integer

    Set wsSet = ActiveWorkbook.Worksheets("Budget_Setup")
    Set wsRead = ActiveWorkbook.Worksheets("WBS_Overview_Read_only")
    Set rngSearch = wsRead.Range("A12:A1000")    'range in READ to search for category
    lastRow = wsSet.Range("B16").End(xlDown).Row     'last row of data in SET

    Application.ScreenUpdating = False

    For i = 17 To lastRow
        strCat = Left(wsSet.Range("b" & i).Value, 3)    'current category in SET
        catRow = rngSearch.Find(strCat).Row             'row of match in READ
        If wsRead.Range("a" & catRow + 1).Value = "" Then   'find the correct row to copy into
            wRow = catRow + 1
        Else
            wRow = wsRead.Range("a" & catRow).End(xlDown).Row + 1
            If wsRead.Range("e" & wRow).Value <> "" Then
                wsRead.Range("a" & wRow).EntireRow.Insert
            End If
        End If
        wsSet.Range("b" & i & ":f" & i).Copy
        wsRead.Range("a" & wRow).PasteSpecial
        Application.CutCopyMode = False
    Next i

    Application.ScreenUpdating = True

    Set wsRead = Nothing
    Set wsSet = Nothing
End Sub

Answer 1

此代码将首先删除Read_Only表单上每个部分中的所有现有数据;然后，通过一次修改，您的代码可以按原样运行。

在Application.ScreenUpdating = False

之后立即添加此行代码

' Erase all data in the Read Only Sheet
    Set currentData = wsRead.Columns(4).Find("Subject")

    Do
        wsRead.Range(currentData.Offset(2, 0), _
            currentData.Offset(2, 0).End(xlDown).Offset(-1, 0)).EntireRow.Delete
        Set currentData = wsRead.Columns(4).FindNext(currentData)
    Loop Until Not currentData Is Nothing And currentData.Row = 12

此代码使用“主题”和“预算成本”单元格删除它之间的现有数据。

接下来，在wRow = catRow + 1

之后立即添加以下代码行

wsRead.Rows(wRow).EntireRow.Insert

这会将第一个空行数据添加到给定的部分。然后，您现有的代码会将新数据插入空白行

Answer 2

我不确定你是如何定义Phase.71，Phase.72等范围的，但是根据我们掌握的信息，这可能适合你。

Sub clearAll()
Dim r As Range, vArr, v
vArr = Array("Phase.71", "Phase.72", "Phase.73", "Phase.74", "Phase.75")
For Each v In vArr
    Set r = ReadOnly.Range(v)
    Set r = r.Offset(2).Resize(r.Rows.Count - 4)
    r.ClearContents
Next v
End Sub

Answer 3

看看这是否适合您。我在你的代码中添加了一行：

For i = 17 To lastRow
    strCat = Left(wsSet.Range("b" & i).Value, 3)    'current category in SET
    catRow = rngSearch.Find(strCat).Row             'row of match in READ
    If wsRead.Range("a" & catRow + 1).Value = "" Then   'find the correct row to copy into
        wRow = catRow + 1

        wsRead.Rows(wRow).EntireRow.Insert 'I added this line

    Else
        wRow = wsRead.Range("a" & catRow).End(xlDown).Row + 1 'end of data
        If wsRead.Range("e" & wRow).Value <> "" Then

现在，在运行您的代码之前运行此代码。

Sub deletePhases()
'   delete phases in Setup from ReadOnly
    Dim r As Range, Col As Collection
    Dim x As Long, l As Long

    With Budget_Setup
        Set r = .Range("b17", .Cells(.Rows.Count, 2).End(xlUp))
    End With
    If r.Row < 17 Then Exit Sub 'no data

    Set Col = New Collection 'build unique list
    On Error Resume Next
    For x = 1 To r.Rows.Count
        Col.Add Left(r(x).Value, 3), Left(r(x).Value, 3)
    Next x

    With ReadOnly
        For x = 1 To Col.Count
            l = .Columns(1).Find(Col(x)).Offset(1).Row '1 below heading
                Do Until .Cells(l, 1) = "" 'end of phase data
                    .Rows(l).Delete
                Loop
        Next x
    End With

End Sub

从一个表复制数据并清除并将新数据更新到excel 2010中另一个工作表的另一个表中

3 个答案: