2

我在一张纸上有这个表格，它有一个带有宏的命令按钮。当我单击它时，它会将 Sheet1 单元格中的所有数据插入到 sheet2 的单行中。我已经放置了下一个空行命令，但我希望所有数据仍然在同一行中，即使前一行是空的。

我使用了以下代码：

    Sub Botao()
    Dim ws1, ws2 As Worksheet
    Dim código, tipo, textobrevematerial, codigopa, textobrevepa, ncm, versão, motivo1, motivo2, motivo3, datarecebimento, _
        dataimpressao, datamkt, datarevisor, datasedev, dataar, datart, dataredmkt, dataredsedev As Range

        Set ws1 = Worksheets("Plan1")
        Set ws2 = Worksheets("Plan2")
        Set código = ws2.Cells(Rows.Count, "a").End(xlUp)
        Set datarecebimento = ws2.Cells(Rows.Count, "b").End(xlUp)
        Set tipo = ws2.Cells(Rows.Count, "c").End(xlUp)
        Set textobrevematerial = ws2.Cells(Rows.Count, "d").End(xlUp)
        Set codigopa = ws2.Cells(Rows.Count, "e").End(xlUp)
        Set textobrevepa = ws2.Cells(Rows.Count, "f").End(xlUp)
        Set ncm = ws2.Cells(Rows.Count, "g").End(xlUp)
        Set versão = ws2.Cells(Rows.Count, "h").End(xlUp)
        Set dataimpressão = ws2.Cells(Rows.Count, "i").End(xlUp)
        Set datamkt = ws2.Cells(Rows.Count, "j").End(xlUp)
        Set datarevisor = ws2.Cells(Rows.Count, "k").End(xlUp)
        Set datasedev = ws2.Cells(Rows.Count, "l").End(xlUp)
        Set dataar = ws2.Cells(Rows.Count, "m").End(xlUp)
        Set datart = ws2.Cells(Rows.Count, "n").End(xlUp)
        Set motivo1 = ws2.Cells(Rows.Count, "o").End(xlUp)
        Set motivo2 = ws2.Cells(Rows.Count, "p").End(xlUp)
        Set motivo3 = ws2.Cells(Rows.Count, "q").End(xlUp)
        Set dataremkt = ws2.Cells(Rows.Count, "r").End(xlUp)
        Set dataresedev = ws2.Cells(Rows.Count, "s").End(xlUp)

            código.Offset(1, 0) = ws1.Range("d4").Value
            datarecebimento.Offset(1, 0) = ws1.Range("H4")
            tipo.Offset(1, 0) = ws1.Range("b8")
            textobrevematerial.Offset(1, 0) = ws1.Range("D8")
            codigopa.Offset(1, 0) = ws1.Range("B12")
            textobrevepa.Offset(1, 0) = ws1.Range("D12")
            ncm.Offset(1, 0) = ws1.Range("B16")
            versão.Offset(1, 0) = ws1.Range("D16")
            dataimpressão.Offset(1, 0) = ws1.Range("F18")
            datamkt.Offset(1, 0) = ws1.Range("F20")
            datarevisor.Offset(1, 0) = ws1.Range("F22")
            datasedev.Offset(1, 0) = ws1.Range("M18")
            dataar.Offset(1, 0) = ws1.Range("M20")
            datart.Offset(1, 0) = ws1.Range("m22")
            motivo1.Offset(1, 0) = ws1.Range("B26")
            motivo2.Offset(1, 0) = ws1.Range("B30")
            motivo3.Offset(1, 0) = ws1.Range("B32")
            dataremkt.Offset(1, 0) = ws1.Range("F38")
            dataresedev.Offset(1, 0) = ws1.Range("M38")

    End Sub

那么即使前一行包含一个空单元格，我应该使用什么代码将所有代码插入同一行？

4

1 回答 1

0

编辑：这个确切的代码在 Excel 中对我有用：

Sub Botao()

Dim ws1, ws2 As Worksheet
Dim rowNum As Long

Set ws1 = Worksheets("Plan1")
Set ws2 = Worksheets("Plan2")
rowNum = ws2.Cells(Rows.Count, "a").End(xlUp).Row 'Get last used row in column A
rowNum = rowNum + 1 'Increment to next open row

Dim código, tipo, textobrevematerial, codigopa, textobrevepa, ncm, versão, motivo1, motivo2, motivo3, datarecebimento, _
dataimpressao, datamkt, datarevisor, datasedev, dataar, datart, dataredmkt, dataredsedev As Range

'Use next open row of column A (rowNum) for all columns
Set código = ws2.Cells(rowNum, "a")
Set datarecebimento = ws2.Cells(rowNum, "b")
Set tipo = ws2.Cells(rowNum, "c")
Set textobrevematerial = ws2.Cells(rowNum, "d")
Set codigopa = ws2.Cells(rowNum, "e")
Set textobrevepa = ws2.Cells(rowNum, "f")
Set ncm = ws2.Cells(rowNum, "g")
Set versão = ws2.Cells(rowNum, "h")
Set dataimpressão = ws2.Cells(rowNum, "i")
Set datamkt = ws2.Cells(rowNum, "j")
Set datarevisor = ws2.Cells(rowNum, "k")
Set datasedev = ws2.Cells(rowNum, "l")
Set dataar = ws2.Cells(rowNum, "m")
Set datart = ws2.Cells(rowNum, "n")
Set motivo1 = ws2.Cells(rowNum, "o")
Set motivo2 = ws2.Cells(rowNum, "p")
Set motivo3 = ws2.Cells(rowNum, "q")
Set dataremkt = ws2.Cells(rowNum, "r")
Set dataresedev = ws2.Cells(rowNum, "s")

'----------Checking for duplicate in column A---------
Dim bool As Boolean
bool = False                  'Initialize False, until duplicate is found

For i = 1 To (rowNum - 1)     'Go through each row of column A except the new row
    If ws1.Range("d4") = ws2.Cells(i, "a") Then  'If it matches any old row set boolean True
        bool = True
    End If
Next i

If bool = True Then           'If duplicate was found, display MsgBox
    Dim msg As String
    Dim title As String
    Dim ret As Integer
    msg = "There is a duplicate in column A"
    title = "Duplicate!"

    ret = MsgBox(msg, vbOKOnly, title) 'MsgBox(Promt, Button(s), Title)
'----------Done checking for duplicate-------------
Else                          'If no duplicate found, insert new row
    'Set values
    código.Value = ws1.Range("d4")
    datarecebimento.Value = ws1.Range("H4")
    tipo.Value = ws1.Range("b8")
    textobrevematerial.Value = ws1.Range("D8")
    codigopa.Value = ws1.Range("B12")
    textobrevepa.Value = ws1.Range("D12")
    ncm.Value = ws1.Range("B16")
    versão.Value = ws1.Range("D16")
    dataimpressão.Value = ws1.Range("F18")
    datamkt.Value = ws1.Range("F20")
    datarevisor.Value = ws1.Range("F22")
    datasedev.Value = ws1.Range("M18")
    dataar.Value = ws1.Range("M20")
    datart.Value = ws1.Range("m22")
    motivo1.Value = ws1.Range("B26")
    motivo2.Value = ws1.Range("B30")
    motivo3.Value = ws1.Range("B32")
    dataremkt.Value = ws1.Range("F38")
    dataresedev.Value = ws1.Range("M38")
End If

End Sub
于 2013-08-20T19:13:57.467 回答