Fatal编程技术网
  • vba/
  • 在VBA中插入行

在VBA中插入行

vba excel

在VBA中插入行,vba,excel,Vba,Excel,现在我有一个员工用于数据输入的主excel工作簿。他们每个人都会将一份副本下载到桌面，然后在完成的数据旁边的comlun中输入“x”，从而在各种条目上标记他们的进度。每个产品都有自己的行，该行中列出了各自的数据。当主工作簿可用时，它会在整个季度内使用产品的新数据填写主工作簿，当前每个工作簿上都会使用一个宏进行更新，该宏只复制数据所在的范围（请参见下面的代码） 我遇到的问题是：每隔一段时间，我需要添加一个新产品，在主控上添加一行（这与添加数据相反，数据只是跨行添加）。有时这行是在结尾，有时它是在中

现在我有一个员工用于数据输入的主excel工作簿。他们每个人都会将一份副本下载到桌面，然后在完成的数据旁边的comlun中输入“x”，从而在各种条目上标记他们的进度。每个产品都有自己的行，该行中列出了各自的数据。当主工作簿可用时，它会在整个季度内使用产品的新数据填写主工作簿，当前每个工作簿上都会使用一个宏进行更新，该宏只复制数据所在的范围（请参见下面的代码）

我遇到的问题是：每隔一段时间，我需要添加一个新产品，在主控上添加一行（这与添加数据相反，数据只是跨行添加）。有时这行是在结尾，有时它是在中间。从下面的代码中可以看出，我的VBA当前无法处理此行更改，因为它只是从预定义范围复制/粘贴。每个用户的工作簿都无法识别行#中的此更改，因此列中的数据与错误的行关联。通常，您可以复制整个工作表并解决问题。我遇到的问题是，每个用户都需要能够在其数据旁边的工作簿中记录自己的流程。是否有方法对此进行编码，以便在不删除/移动每个用户所做标记的情况下，将母版页上的新行计入并添加到所有其他行？我一直在试图找到一种方法，如果主控中的行是新的，那么它可以“插入”行，因为这样可以保留数据，但无法找到它。此外，由于工作时服务器上的安全性，链接工作簿等不是一个选项。有人对此有什么想法吗

解决此问题的一种方法是使用
Scripting.Dictionary
对象。您可以为目标标识符和源标识符创建一个字典，并对它们进行比较。我想你并不真的需要键值对来实现这一点，但希望这能让你走上正轨

Sub Main()

Dim source As Worksheet
Dim target As Worksheet
Dim dictSource As Object
Dim dictTarget As Object
Dim rng As Range
Dim i As Integer
Dim j As Integer
Dim idSource As String
Dim idTarget As String
Dim offset As Integer

Set source = ThisWorkbook.Sheets(2)
Set target = ThisWorkbook.Sheets(1)

offset = 9 'My data starts at row 10, so the offset will be 9

Set rng = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row)
Set dictSource = CreateObject("Scripting.Dictionary")
For Each cell In rng
    dictSource.Add Key:=cell.Value, Item:=cell.Row
Next

Set rng = target.Range("A10:A" & target.Cells(target.Rows.Count, "A").End(xlUp).Row)
Set dictTarget = CreateObject("Scripting.Dictionary")
For Each cell In rng
    dictTarget.Add Key:=cell.Value, Item:=cell.Row
Next

i = 1
j = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row).Rows.Count
Do While i <= j
Retry:
    idSource = source.Cells(i + offset, 1).Value
    idTarget = target.Cells(i + offset, 1).Value
    If Not (dictSource.Exists(idTarget)) And idTarget <> "" Then
        'Delete unwanted rows
        target.Cells(i + offset, 1).EntireRow.Delete
        GoTo Retry
    End If
    If dictTarget.Exists(idSource) Then
        'The identifier was found so we can update the values here...
        dictTarget.Remove (idSource)
    ElseIf idSource <> "" Then
        'The identifier wasn't found so we can insert a row
        target.Cells(i + offset, 1).EntireRow.Insert
        'And you're ready to copy the values over
        target.Cells(i + offset, 1).Value = idSource
    End If
    i = i + 1
Loop

Set dictSource = Nothing
Set dictTarget = Nothing

End Sub

Sub-Main（）
将源设置为工作表
将目标变暗为工作表
将源作为对象
将目标视为对象
变暗rng As范围
作为整数的Dim i
作为整数的Dim j
将idSource设置为字符串
将目标设置为字符串
作为整数的Dim偏移
Set source=ThisWorkbook.Sheets（2）
设置目标=此工作簿。工作表（1）
offset=9'我的数据从第10行开始，因此偏移量为9
设置rng=source.Range（“A10:A”和source.Cells（source.Rows.Count，“A”）.End（xlUp.Row）
Set dictSource=CreateObject（“Scripting.Dictionary”）
对于rng中的每个单元
dictSource.Add键：=cell.Value，项：=cell.Row
下一个
Set rng=target.Range（“A10:A”和target.Cells（target.Rows.Count，“A”）.End（xlUp.Row）
Set dictTarget=CreateObject（“Scripting.Dictionary”）
对于rng中的每个单元
dictTarget.Add键：=cell.Value，项：=cell.Row
下一个
i=1
j=source.Range（“A10:A”和source.Cells（source.Rows.Count，“A”）.End（xlUp.Row）.Rows.Count

每个产品都有唯一的名称或其他唯一的标识符吗？是的，它们有。前7列左右都是产品的唯一列，每个列都可以单独作为标识符。更新主工作簿时，您是只添加新产品，还是更新现有行？我更新现有行，也添加它们。因此，假设您在最左边的列中有产品名称、序列号和一些其他标识符，然后是性能、折旧等，这些都会针对每个产品进行更新。产品（行）是间歇性添加的。我在上面的代码中注意到的一个疏忽是，如果
目标
工作表上的标识符列表比
源
工作表上的标识符列表长，则不会处理剩余的行。我不知道这是否是你最终会遇到的情况，但注意到这一点很好。这看起来很棒，谢谢！等我有时间的时候，我会再处理一下，然后再给你回复。快速看一下，这是从母版工作表中的一列创建字典，对吗？我想的是，如果我运行这段代码，它将为该信息添加一行，那么我应该能够修改我的旧代码，以便在以后更新目标工作表上的新范围，对吗？感谢您在这方面的帮助-我期待着尝试它它是从主工作表和目标工作表中的一列创建字典-
dictSource
具有主工作表中包含您的标识符的列，
dictTarget
在目标工作表中包含相同的标识符。将插入行以尝试将目标工作表与主工作表匹配，而不替换两个字典中存在的标识符中的数据。你可能只需要一本字典就可以做到这一点，甚至不用字典，因为这只是使用
Exists
功能来搜索关键字。这正是我想要做的，谢谢！今天晚些时候，我有时间玩过之后会给你回复，让你知道进展如何。您认为
Exists
函数与
dictSource
和
dictTarget
相比，有什么真正的优势吗？在这一点上，我欠你一些研究和尝试/错误——只是想知道你是否有意见——我很高兴它正在做你需要的事情——尽管我确实觉得有必要澄清一件事。
Exists
函数是
Scripting.Dictionary
对象的一部分，因此我首先选择使用
dictSource
和
dictTarget
。我们使用字典的功能是简单地列出标识符并搜索该列表中可能的匹配项-您可以在没有字典的情况下使用列表或数组并创建一个函数来搜索特定标识符。查看详细信息。

Sub Main()

Dim source As Worksheet
Dim target As Worksheet
Dim dictSource As Object
Dim dictTarget As Object
Dim rng As Range
Dim i As Integer
Dim j As Integer
Dim idSource As String
Dim idTarget As String
Dim offset As Integer

Set source = ThisWorkbook.Sheets(2)
Set target = ThisWorkbook.Sheets(1)

offset = 9 'My data starts at row 10, so the offset will be 9

Set rng = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row)
Set dictSource = CreateObject("Scripting.Dictionary")
For Each cell In rng
    dictSource.Add Key:=cell.Value, Item:=cell.Row
Next

Set rng = target.Range("A10:A" & target.Cells(target.Rows.Count, "A").End(xlUp).Row)
Set dictTarget = CreateObject("Scripting.Dictionary")
For Each cell In rng
    dictTarget.Add Key:=cell.Value, Item:=cell.Row
Next

i = 1
j = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row).Rows.Count
Do While i <= j
Retry:
    idSource = source.Cells(i + offset, 1).Value
    idTarget = target.Cells(i + offset, 1).Value
    If Not (dictSource.Exists(idTarget)) And idTarget <> "" Then
        'Delete unwanted rows
        target.Cells(i + offset, 1).EntireRow.Delete
        GoTo Retry
    End If
    If dictTarget.Exists(idSource) Then
        'The identifier was found so we can update the values here...
        dictTarget.Remove (idSource)
    ElseIf idSource <> "" Then
        'The identifier wasn't found so we can insert a row
        target.Cells(i + offset, 1).EntireRow.Insert
        'And you're ready to copy the values over
        target.Cells(i + offset, 1).Value = idSource
    End If
    i = i + 1
Loop

Set dictSource = Nothing
Set dictTarget = Nothing

End Sub