加速使用string填充单元格的代码

下面是一些非常简单的代码,用string填充单元格,并沿着方向打印到状态栏,给用户一些反馈。 无论如何,我可以更快地做到这一点吗?

像screenupdating的东西已经被禁用。

我的想法是将string发送到一个数组,然后从数组中填充单元格,但我不确定将完成这样的任务的代码。

让我知道我能做什么!

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 

您可以一次性添加值:

 Dim arr arr = Array("one", "Two", "Three") Range("a1").Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr) 

我知道答案已经被接受,但我认为这是一个更灵活的答案。 在希望标题的工作簿中,创build一个名为“Lists”的工作表。 在新的List工作表的A列中,把你的头文件放在A2中,然后往下走,他们需要做的事情(可以随意放入A1中的“HeaderList”)……这也假定你想要数据复制到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 

所以当你需要改变数据的时候,关于这段代码和使用帮助表的好处就来了。 实际上,您不必更改“列表”选项卡上的列表列。 代码不需要改变。

你可以做一些额外的检查最后一行和东西,但我的代码是为了指导。

 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