下面是一些非常简单的代码,用字符串填充单元格,并沿途打印到状态栏以向用户提供一些反馈。无论如何我能更快地做到这一点吗?
像screenupdating这样的东西已经被禁用了。
我的想法是将字符串发送到数组,然后从数组中填充单元格,但我不确定将完成此任务的代码。
让我知道我能做些什么!
Sub SheetNames()
DoEvents
Application.StatusBar = "Populating array (0)"
Range("O1") = "ASRS"
Range("O2") = "Base Coat Line"
Range("O3") = "Base Coat Line 2"
Range("O4") = "Body Shop Feed"
Range("O5") = "Cavity Wax Manual"
Application.StatusBar = "Populating array (5)"
Range("O6") = "Cavity Wax Masking"
Range("O7") = "Cavity Wax Oven"
Range("O8") = "Cavity Wax Robots"
Range("O9") = "Clear Coat Line 1"
Range("O10") = "Clear Coat Line 2"
Application.StatusBar = "Populating array (10)"
Range("O11") = "Control Room Robots"
Range("O12") = "Crane 1"
Range("O13") = "Crane 2"
Range("O14") = "Crane 3"
Range("O15") = "Crane 4"
Application.StatusBar = "Populating array (15)"
Range("O16") = "Crane 5"
Range("O17") = "Crane 6"
Range("O18") = "De-Mask"
Range("O19") = "Delivery From Assembly"
Range("O20") = "Delivery To Assembly"
Application.StatusBar = "Populating array (20)"
Range("O21") = "E-Coat"
Range("O22") = "E-Coat Dip Process"
Range("O23") = "E-Coat Oven"
Range("O24") = "E-Coat Sand Strip Out"
Range("O25") = "E-Coat Sand Strip Out Buffer"
Application.StatusBar = "Populating array (25)"
Range("O26") = "Final Inspection"
Range("O27") = "Interior Sealer 2A"
Range("O28") = "Interior Sealer 2B"
Range("O29") = "Interior Sealer Manual"
Range("O30") = "Interior Sealer Robots"
Application.StatusBar = "Populating array (30)"
Range("O31") = "Manual Work Decks"
Range("O32") = "Mix Room"
Range("O33") = "Phosphate"
Range("O34") = "Phosphate Process"
Range("O35") = "Polish Line"
Application.StatusBar = "Populating array (35)"
Range("O36") = "Pre-Trim"
Range("O37") = "Prim Booth"
Range("O38") = "Prim Color Sort Buffer"
Range("O39") = "Prime Oven"
Range("O40") = "Prime Oven & PSO"
Application.StatusBar = "Populating array (40)"
DoEvents
Range("O41") = "Primer Automation"
Range("O42") = "Primer Prep"
Range("O43") = "Primer Tackoff"
Range("O44") = "RTO 1"
Range("O45") = "RTO 2"
Application.StatusBar = "Populating array (45)"
Range("O46") = "RTO 3"
Range("O47") = "Sealer Oven"
Range("O48") = "Sealer Prep"
Range("O49") = "Sealer Strip Out"
Range("O50") = "Skid Wash"
Application.StatusBar = "Populating array (50)"
Range("O51") = "Spot Repair Conveyor"
Range("O52") = "Topcoat Blower/Feather"
Range("O53") = "Topcoat Booth 1"
Range("O54") = "Topcoat Booth 2"
Range("O55") = "Topcoat Prep"
Application.StatusBar = "Populating array (55)"
Range("O56") = "Topcoat Strip Out"
Range("O57") = "UBS"
Range("O58") = "UBS Manual"
Range("O59") = "UBS Robots"
Range("O60") = "VIN Scribe Robot"
Application.StatusBar = "Populating array (60)"
Range("O61") = "Waste Water Process"
Application.StatusBar = "Array populated."
End Sub
以下是几个答案的组合,其工作原点,而且更快!
Sub FillRangeFromArray()
Dim S As Variant
Dim i As Long
S = Array("ASRS", "Base Coat Line", "Base Coat Line 2", "Body Shop Feed", "Cavity Wax Manual", _
"Cavity Wax Masking", "Cavity Wax Oven", "Cavity Wax Robots", "Clear Coat Line 1", "Clear Coat Line 2", _
"Control Room Robots", "Crane 1", "Crane 2", "Crane 3", "Crane 4", "Crane 5", "Crane 6", "De-Mask", _
"Delivery From Assembly", "Delivery To Assembly", "E-Coat", "E-Coat Dip Process", "E-Coat Oven", _
"E-Coat Sand Strip Out", "E-Coat Sand Strip Out Buffer", "Final Inspection", "Interior Sealer 2A", _
"Interior Sealer 2B", "Interior Sealer Manual", "Interior Sealer Robots", "Manual Work Decks", "Mix Room", _
"Phosphate", "Phosphate Process", "Polish Line", "Pre-Trim", "Prim Booth", "Prim Color Sort Buffer", "Prime Oven", _
"Prime Oven & PSO", "Primer Automation", "Primer Prep", "Primer Tackoff", "RTO 1", "RTO 2", "RTO 3", _
"Sealer Oven", "Sealer Prep", "Sealer Strip Out", "Skid Wash", "Spot Repair Conveyor", _
"Topcoat Blower/Feather", "Topcoat Booth 1", "Topcoat Booth 2", "Topcoat Prep", "Topcoat Strip Out", _
"UBS", "UBS Manual", "UBS Robots", "VIN Scribe Robot", "Waste Water Process")
Range("O1").Resize(UBound(S) + 1, 1).Value = Application.Transpose(S)
End Sub
答案 0 :(得分:4)
您可以一次性添加值:
Dim arr
arr = Array("one", "Two", "Three")
Range("a1").Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr)
答案 1 :(得分:2)
我知道答案已被接受,但我认为这是一个更灵活的答案。在您想要标题的工作簿中,创建一个名为" Lists"的工作表。在新列表工作表的A列中,放入从A2开始的标题,然后向下移动它们需要做的事情(随意输入类似" HeaderList"在A1中)....这也是假设您希望将数据复制到Sheet1(您需要根据自己的情况进行更改)。
Sub HeaderMover()
Dim lr As Long
lr = Sheets("Lists").Range("A65536").End(xlUp).Row
Sheets("Lists").Range("A2:A" & lr).Copy
Sheet1.Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub
因此,当您需要更改数据时,这段代码和使用帮助工作表的好处就出现了。除了列表选项卡上的列表列之外,您实际上不必更改任何内容。代码中不需要进行任何更改。
你可以在最后一行和附近做一些额外的检查,但我的代码是一个指南。
答案 2 :(得分:1)
Sub SheetNames()
Dim S(61) As String
DoEvents
S(1) = "ASRS"
S(2) = "Base Coat Line"
S(3) = "Base Coat Line 2"
S(4) = "Body Shop Feed"
S(5) = "Cavity Wax Manual"
S(6) = "Cavity Wax Masking"
S(7) = "Cavity Wax Oven"
S(8) = "Cavity Wax Robots"
S(9) = "Clear Coat Line 1"
S(10) = "Clear Coat Line 2"
S(11) = "Control Room Robots"
S(12) = "Crane 1"
S(13) = "Crane 2"
S(14) = "Crane 3"
S(15) = "Crane 4"
S(16) = "Crane 5"
S(17) = "Crane 6"
S(18) = "De-Mask"
S(19) = "Delivery From Assembly"
S(20) = "Delivery To Assembly"
S(21) = "E-Coat"
S(22) = "E-Coat Dip Process"
S(23) = "E-Coat Oven"
S(24) = "E-Coat Sand Strip Out"
S(25) = "E-Coat Sand Strip Out Buffer"
S(26) = "Final Inspection"
S(27) = "Interior Sealer 2A"
S(28) = "Interior Sealer 2B"
S(29) = "Interior Sealer Manual"
S(30) = "Interior Sealer Robots"
S(31) = "Manual Work Decks"
S(32) = "Mix Room"
S(33) = "Phosphate"
S(34) = "Phosphate Process"
S(35) = "Polish Line"
S(36) = "Pre-Trim"
S(37) = "Prim Booth"
S(38) = "Prim Color Sort Buffer"
S(39) = "Prime Oven"
S(40) = "Prime Oven & PSO"
S(41) = "Primer Automation"
S(42) = "Primer Prep"
S(43) = "Primer Tackoff"
S(44) = "RTO 1"
S(45) = "RTO 2"
S(46) = "RTO 3"
S(47) = "Sealer Oven"
S(48) = "Sealer Prep"
S(49) = "Sealer Strip Out"
S(50) = "Skid Wash"
S(51) = "Spot Repair Conveyor"
S(52) = "Topcoat Blower/Feather"
S(53) = "Topcoat Booth 1"
S(54) = "Topcoat Booth 2"
S(55) = "Topcoat Prep"
S(56) = "Topcoat Strip Out"
S(57) = "UBS"
S(58) = "UBS Manual"
S(59) = "UBS Robots"
S(60) = "VIN Scribe Robot"
S(61) = "Waste Water Process"
For i = 1 To 61
Range("O" & i) = S(i)
Application.StatusBar = "Populating array (" & i & ")"
Next i
end sub