编写一个宏来检查是否已填充一个单元格,然后将相应的信息写到另一张表中

时间:2019-06-17 14:23:11

标签: excel vba

我当前正在为一个项目列表编写一个宏,以检查是否选中了某个项目,如果选中了该项目,它将把所有相应的项目信息传输到另一张纸上。我的代码没有产生任何错误,但是也没有按照我想要的去做。我仍在学习如何使用VBA语法,因此可能会遗漏一些非常简单的内容,但这是我的代码

Sub ExportCableTray()

Dim UOM As Range
Dim QTY  As Range
Dim MTL As Range
Dim DMT As Range
Dim IT As Range
Dim IST As Range
Dim num As Range
Dim des As Range



Dim rng As Range, Cell As Range
Dim i As Integer
Dim Seq As Integer

Seq = 1 'Defines the Seq column in the Export Sheet
i = 8 'counter that goes through the cable tray
j = 12 'counter that decides the row value for the Export Sheet



Set rng = Sheets("Cable Tray").Range("I8:I185")


For Each Cell In rng
    If Len(Cell) <> 0 Then

                Set UOM = Sheets("Cable Tray").Cells(i, 5)
                Set QTY = Sheets("Cable Tray").Cells(i, 15)
                Set MTL = Sheets("Cable Tray").Cells(i, 7)
                Set DMT = Sheets("Cable Tray").Cells(i, 8)
                Set IT = Sheets("Cable Tray").Cells(i, 9)
                Set IST = Sheets("Cable Tray").Cells(i, 10)
                Set num = Sheets("Cable Tray").Cells(i, 2)
                Set des = Sheets("Cable Tray").Cells(i, 3)


                UOM.Copy Destination:=Sheets("Export Sheet").Cells(j, 4)
                QTY.Copy Destination:=Sheets("Export Sheet").Cells(j, 5)
                MTL.Copy Destination:=Sheets("Export Sheet").Cells(j, 6)
                DMT.Copy Destination:=Sheets("Export Sheet").Cells(j, 7)
                IT.Copy Destination:=Sheets("Export Sheet").Cells(j, 8)
                IST.Copy Destination:=Sheets("Export Sheet").Cells(j, 9)
                Sheets("Export Sheet").Cells(j, 1).Value = Seq
                num.Copy Destination:=Sheets("Export Sheet").Cells(j, 2)
                des.Copy Destination:=Sheets("Export Sheet").Cells(j, 3)

                i = i + 1
                Seq = Seq + 1
                j = j + 1



      End If

      Next Cell

End Sub

我可能使事情变得过于复杂,任何帮助将不胜感激!

1 个答案:

答案 0 :(得分:0)

i = i + 1需要超出IF语句,因为即使当前单元格为空白,也需要继续检查单元格。所以你最后几行应该退缩

            Seq = Seq + 1
            j = j + 1

  End If
  i = i + 1
  Next Cell