首页 文章

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

提问于
浏览 次
0

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

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复制所有数据（这很费时，也因为“工作表”（“sheet2”） . 范围（“B2”）= vbNullString“它将数据添加到其余空行，不更新他们）

2-I无法检查B列的值，看是否有一个名为“one three”的字段来更新它 .

最后，不要忘记：我是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

excel vba excel-vba worksheet-function

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

    EDITED: So, once again... 我希望我没有't miss any part of your concept. I'我不确定因为你写的关于从sheet1到sheet2的复制，而你的代码从sheet2复制到sheet1 .
    enter image description here

    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
    回复于

相关问题