加速使用字符串简单填充单元格的代码

时间:2014-06-19 15:31:49

标签: excel performance excel-vba vba

下面是一些非常简单的代码,用字符串填充单元格,并沿途打印到状态栏以向用户提供一些反馈。无论如何我能更快地做到这一点吗?

像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

3 个答案:

答案 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