0

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

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

正如我在第二篇文章中所写，更新按钮将更新更改的行，并尝试查找是否有任何行具有“一 + 三”形式。因此，它还会将数据从“一”和“三”复制到该行。将来如果添加另一个多名称行（如：一+四或二+三），按钮将执行相同的操作。

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

 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 复制所有数据（这很耗时，而且由于 "Worksheets("sheet2").Range("B2") = vbNullString" 它会将数据添加到其余的空行中，不更新它们）

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

最后，不要忘记：我是 VBA 和 excel 编程的新手！先感谢您

更新 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

4

1 回答 1

0

而不是你的：

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

编辑：所以，再一次......我希望我没有错过你概念的任何部分。我不确定，因为您写的是从 sheet1 到 sheet2 的复制，而您的代码从 sheet2 复制到 sheet1。在此处输入图像描述在此处输入图像描述

以及完整的代码：

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
于 2013-04-04T13:47:20.000 回答