Question

正如我在标题中提到的，我需要将数据从一张表复制到另一张表。我在两张表中都有相同的数据（不是以相同的顺序）。我想更新第一张中的数据，因为第二张中的相应行已更改。例如，我在第一张表中：

A   B           C 
1   one         1.1
2   two         1.2
3   three       1.3
4   one + two   2.3
5   one + three  ??

和第二个：

A   B          C 
1   one        1.1
2   two        1.2
3   three      1.3

当我在第二页写时，更新按钮将更新已更改的行，并尝试查找是否有任何行具有＃34;一个+三个＆＃34;。因此，它还将复制来自＆＃34; one＆＃34;和＆＃34;三＆＃34;那一排。将来如果添加了另一个多名称行（例如：一个+四个或两个+三个），按钮将执行相同的操作。

我尝试通过以下代码更新工作表中的所有数据：

 Private Sub CommandButton2_Click()

 Dim salesData As Range, targetRng As Range
 Dim e As Integer
 Set salesData = Worksheets("sheet1").Range("A2:C" & Range("A1").End(xlDown).Row)

 If Worksheets("sheet2").Range("B2") = vbNullString Then
      Set targetRng = Worksheets("sheet2").Range("A2") 'If no data in SalesDB start in row 2
 Else
      Set targetRng = Worksheets("sheet2").Range("A1").End(xlDown).Offset(1, 0) 'If data already in SalesDB, find next free row
 End If
 salesData.Copy Destination:=targetRng
 End Sub

但它对我来说并不有用： 1复制所有数据（它耗费时间，也因为＆＃34;工作表（＆＃34; sheet2＆＃34;）。范围（＆＃34; B2＆＃34;）= vbNullString＆＃34;它添加数据到其余的空行，而不是更新它们）

2 - 我无法检查B列的值，看是否有这样一个名为＆＃34;一个+三个＆＃34;的字段。更新它。

最后，请不要忘记：我是VBA的新手，并且优秀的编程！提前谢谢

更新1 ::

 Private Sub CommandButton5_Click()
 'here the beginning of  of your solution
 'after and instead of this line:
 'salesData.Copy Destination:=targetRng
 'try this... but carefully for the first time :)
  Dim salesData As Range, targetRng As Range
 Dim e As Integer
 Set salesData = Worksheets("sheet1").Range("A2:C" & Range("A1").End(xlDown).Row)

  ' Worksheets("Sheet2").Select

 If Worksheets("sheet2").Range("B2") = vbNullString Then
      Set targetRng = Worksheets("sheet2").Range("A2") 'If no data in SalesDB start in        row 2
 Else
      Set targetRng = Worksheets("sheet2").Range("A1").End(xlDown).Offset(1, 0) 'If   data already in SalesDB, find next free row
 End If

 targetRna.Columns(3).ClearContents

Dim dataItem
Dim Found As Range
Dim rngStart As Range
Set rngStart = targetRna.Cells(1, 1)
Dim strFirstAddress As String
For Each dataItem In salesData.Columns(2).Cells

Set Found = targetRna.Find(dataItem.Value, rngStart, xlValues, xlPart)

If Not Found Is Nothing Then
    strFirstAddress = Found.Address

    Do
        If dataItem.Value = Found.Value Then
            Found.Offset(0, 1) = dataItem.Offset(0, 1)
        Else
            Found.Offset(0, 1) = Found.Offset(0, 1) + dataItem.Offset(0, 1)
        End If
        Set rngStart = Found

    Set Found = targetRna.Find(dataItem.Value, rngStart, xlValues, xlPart)

    If Found Is Nothing Then
        Exit Do
    ElseIf Found.Address = strFirstAddress Then
        Exit Do
    End If


    Loop
End If

Next
End Sub

EDIT2 :: （）清除地址中的空格以查看图像！[按钮会影响此表] [1] [1]：http://i.stack.imgur.com/ zSg1p.png

！[更新按钮将在此处] [2] [2]：http://i.stack.imgur.com/ sNiVK.png

Answer 1

而不是你的：

salesData.Copy Destination:=targetRng

尝试使用以下代码：

Private Sub CommandButton2_Click()
'here the beginning of  of your solution
'after and instead of this line:
'salesData.Copy Destination:=targetRng
'try this... but carefully for the first time :)

targetRna.Columns(3).ClearContents

Dim dataItem
Dim Found As Range
Dim rngStart As Range
Set rngStart = targetRna.Cells(1, 1)
    Dim strFirstAddress As String
For Each dataItem In salesData.Columns(2).Cells

    Set Found = targetRna.Find(dataItem.Value, rngStart, xlValues, xlPart)

    If Not Found Is Nothing Then
        strFirstAddress = Found.Address

        Do
            If dataItem.Value = Found.Value Then
                Found.Offset(0, 1) = dataItem.Offset(0, 1)
            Else
                Found.Offset(0, 1) = Found.Offset(0, 1) + dataItem.Offset(0, 1)
            End If
            Set rngStart = Found

        Set Found = targetRna.Find(dataItem.Value, rngStart, xlValues, xlPart)

        If Found Is Nothing Then
            Exit Do
        ElseIf Found.Address = strFirstAddress Then
            Exit Do
        End If


        Loop
    End If

Next
End Sub

编辑：所以，再一次...... 我希望我不会错过你的概念的任何部分。我不确定，因为当你的代码从sheet2复制到sheet1时，你写的是从sheet1到sheet2的复制。 enter image description here

完整的代码：

Private Sub CommandButton2_Click()
    Dim salesData As Range, targetRng As Range
    Dim e As Integer
    Set salesData = Worksheets("sheet2").Range("A1:C" & Range("A1").End(xlDown).Row)

   If Worksheets("sheet1").Range("B2") = vbNullString Then
   Set targetRng = Worksheets("sheet1").Range("A2") 'If no data in SalesDB start in        row 2
   salesData.Copy Destination:=targetRng
   Exit Sub
   Else
  'if data already exists than set range to search in
  Set targetRng = Worksheets("sheet1").Range("A1").CurrentRegion
  End If

  targetRng.Columns(3).ClearContents

   Dim boFound As Boolean
   Dim dataItem
   Dim Found As Range
   Dim rngStart As Range
   Set rngStart = targetRng.Cells(1, 1)
   Dim strFirstAddress As String
   For Each dataItem In salesData.Columns(2).Cells

          Set Found = targetRng.Find(dataItem.Value, rngStart, xlValues, xlPart)

          If Not Found Is Nothing Then
          strFirstAddress = Found.Address
          boFound = True
             Do 
               If dataItem.Value = Found.Value Then
                  Found.Offset(0, 1) = dataItem.Offset(0, 1)
               Else
                  Found.Offset(0, 1) = Found.Offset(0, 1) + dataItem.Offset(0, 1)
               End If
          Set rngStart = Found

         Set Found = targetRng.Find(dataItem.Value, rngStart, xlValues, xlPart)

         If Found Is Nothing Then
              Exit Do
         ElseIf Found.Address = strFirstAddress Then
             Exit Do
         End If
         Loop
   End If

   If Not boFound Then
          'if not found then copy into first free row
         dataItem.Offset(0, -1).Resize(1, 3).Copy Worksheets("sheet1").Range("A1").End(xlDown).Offset(1, 0)
   End If

   boFound = False

   Next


   End Sub

在VBA中将数据更新到excel中适当的列和行，从一个工作表到另一个工作表

1 个答案: