Question

我正在开发一个Excel宏，它可以合并两个电子表格 - 公司列表以及与这些公司相关的电子邮件列表。每当公司有多个电子邮件关联时，我需要为该电子邮件创建一个单独的行。

一切正常，直到我尝试在宏的末尾创建代码为Rows(row).Resize(1).Insert的新行。只要它到达此行，Excel就会无限制地复制每一行的第一列广告（直到列 XEI ）。

如何修改我的代码，以便创建一个新行（在我的循环当前行的行下）而不是一百万列？我的代码如下：

Sub Commandbutton1()


ThisWorkbook.Sheets("company").Activate


Sheet2.Range("A1:A10000").Select

Selection.Copy


ThisWorkbook.Sheets("Sheet1").Activate


Sheet1.Range("A1:A10000").Value = Sheet2.Range("A1:A10000").Value

Sheet1.Range("B1").Value = "First Name"

Sheet1.Range("C1").Value = "Last Name"

Sheet1.Range("D1").Value = "Email"




Dim i As Integer


i = 1


Do While i <= 100

Dim companyName As String
companyName = Cells(i, 1).Value
firstname = Cells(i, 2).Value
lastname = Cells(i, 3).Value

'Query contacts list
'Find all rows containing companyName
'Find the email in those rows
'Add the email to row i

Dim slot As Integer

slot_email = 4


Dim result As String
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets("contact")


Dim isFirstInstance As Integer

isFirstInstance = 0

Dim j As Integer

For j = 1 To sheet.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count



    Dim k As Integer
    For k = 1 To 39
        Dim cellVal As String
        cellVal = ActiveWorkbook.Worksheets("contact").Cells(j, k).Value
            If cellVal = "" Then
            Exit For
        ElseIf cellVal = companyName Then
            Debug.Print ("For company " & companyName & ", found value on row " & j & " col " & k)
            Cells(i, 4).Value = ActiveWorkbook.Worksheets("contact").Cells(j, 4).Value
            Cells(i, 2).Value = ActiveWorkbook.Worksheets("contact").Cells(j, 2).Value
            Cells(i, 3).Value = ActiveWorkbook.Worksheets("contact").Cells(j, 3).Value

            isFirstInstance = isFirstInstance + 1
                Debug.Print (isFirstInstance & " on column " & k)

            If isFirstInstance > 1 Then
                Debug.Print ("Found a duplicate contact!")

                Dim row As String
                row = i

                Rows(row).Resize(1).Insert

                i = i + 1
            End If

        End If
    Next k
Next j

i = i + 1


Loop



End Sub

Answer 1

我相信Rows（行）.Resize（1）.Insert会将您的单列向下移动而不是整行（为此您插入新的数据行）。我想你想使用：Rows（5）.EntireRow.Insert例如，并且还使用Application.CutCopyMode = False，这样它就不会尝试插入以前复制的数据

Answer 2

MainClassApplicationUnderTest

将转换

Sub InsertRowAtSecondLine()
    Dim rowOfInterest As Long
    rowOfInterest = 2
    Cells(rowOfInterest, 1).EntireRow.Insert
End Sub

到

a
b
c
d

在Excel VBA宏中创建一个新行（我做错了什么？）

2 个答案: