时间戳

首页 > 解决方案 > 选择 do-loop 的起始单元格

excel - 选择 do-loop 的起始单元格

问题描述

我想开始一个循环中间列（比如说第 15 行）。

当前代码（更大脚本的一部分）

Range("C2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R15C3"

Dim BlankFound As Boolean
Dim x As Long

'Loop until a blank cell is found in Column C
  Do While BlankFound = False
    x = x + 1

    If Cells(x, "C").Value = "" Then
      BlankFound = True
    End If
  Loop

我尝试将列 ref (C) 更改为单元格 (C15)。我试图指定起点和终点（C15：C）。

我们有一个客户订单，当他们点击一个按钮时，它会转换成另一种格式，可以上传。客户将填写填充第 1 行和第 2 行（姓名、地址等）的各个字段，然后从第 3 行开始填写订单数量，即

第 3行
零件号数量可用性
4 零件号数量可用性

我希望它查看原始表单，并且仅在它在原始表单的单元格中找到值时才向下填充。

然后在最后我要添加另一行，所以我需要能够说明这个循环何时完成，添加这些值（这些只是额外的总计行和一些格式）。

完整代码——

Sub ButtonMacroLatest()
'Hide alerts
Application.DisplayAlerts = False
'
' Macro8 Macro
'

'Save to users device
    ChDir "U:\WINDOWS"
    ActiveWorkbook.SaveAs Filename:="U:\WINDOWS\OrderForm.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False

'Create new workbook and populate
    Workbooks.Add
    ActiveCell.FormulaR1C1 = "MSG"
    Range("B1").FormulaR1C1 = "=[OrderForm.xlsx]Order!R[1]C"
    Range("C1").FormulaR1C1 = "=[OrderForm.xlsx]Order!R[1]C[3]"
    Range("D1").FormulaR1C1 = "1400008000"
    Range("E1").FormulaR1C1 = "501346009175"
    Range("F1").FormulaR1C1 = "=TODAY()"
    Range("G1").FormulaR1C1 = "=Now()"
    Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    Range("A2").FormulaR1C1 = "HDR"
    Range("B2").FormulaR1C1 = "C"
    Range("C2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R4C2"
    Range("G2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R[1]C[3]"
    Range("H2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R2C4"
    Range("K2").FormulaR1C1 = "STD"
    Range("L2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R5C2"
    Range("N2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R7C2"
    Range("O2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R8C2"
    Range("Q2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R9C2"
    Range("R2").FormulaR1C1 = "=[OrderForm.xlsx]Order!R12C2"
    Range("A3").FormulaR1C1 = "POS"
    Range("B3").FormulaR1C1 = "=Row()*10-20"
    Range("C3").FormulaR1C1 = "=[OrderForm.xlsx]Order!R15C3"
Dim BlankFound As Boolean
Dim x As Long

'Loop until a blank cell is found in Column C
  Do While BlankFound = False
    x = 14
    x = x + 1

    If Cells(x, "C").Value = "" Then
      BlankFound = True
    End If
  Loop

    Range("D3").FormulaR1C1 = "=[OrderForm.xlsx]Order!R15C1"
    Range("E3").FormulaR1C1 = "=[OrderForm.xlsx]Order!R15C2"
    Range("F3").FormulaR1C1 = "=[OrderForm.xlsx]Order!R15C5"
    Range("G3").FormulaR1C1 = "=[OrderForm.xlsx]Order!R15C7"

    'Preformat cells to remove 0 value
    Range("A1:AP1000").Select
    Range("AP1000").Activate
    Selection.NumberFormat = "#;#;"

    Range("H3").FormulaR1C1 = "GBP"
    Range("L3").FormulaR1C1 = "TRA"
    Range("M3").FormulaR1C1 = "=COUNTIF(C[-3], ""POS"")+COUNTIF(C[-3], ""HDR"")"


'Reinstate alerts
Application.DisplayAlerts = True
End Sub

在面向客户的表格 A15:C15 中是材料/零件编号。如果填充了这些行，则应填写新表单，直到原始表单中没有条目。

客户表格
客户表格

标签： excelvba

解决方案

我无法弄清楚你从哪里获取值以及将它们放在哪里，但希望这段代码能给你足够的想法来整理你的想法。 

Public Sub ButtomMacroLatest()

    Dim wrkBk As Workbook
    Dim wbOF As Workbook
    Dim shtCSV As Worksheet
    Dim shtOF As Worksheet
    Dim lLastRow As Long
    Dim x As Long, y As Long

    'OrderForm is closed so needs opening:
    'Set wbOF = Workbooks.Open("U:\.......\OrderForm.xlsx")

    'OrderForm is the workbook containing this code:
    Set wbOF = ThisWorkbook

    'Set a reference to the "Order" sheet and
    'find the last row - based on column A being populated.
    Set shtOF = wbOF.Worksheets("Order")
    lLastRow = shtOF.Cells(Rows.Count, 1).End(xlUp).Row

    'Create workbook with 1 sheet and set reference to that sheet.
    Set wrkBk = Workbooks.Add(xlWBATWorksheet)
    Set shtCSV = wrkBk.Worksheets(1)

    'Add headings to the sheet.
    shtCSV.Range("A1:G1") = Array("MSG", "SomeHeading", "SomeOtherHeading", "1400008000", _
                                  "501346009175", Date, Now)

    'Copy values in cell "A15:J<LastRow>" to "A2" on the new sheet.
    With shtOF
        'Straight copy
        '.Range(.Cells(15, 1), .Cells(lLastRow, 10)).Copy _
            Destination:=shtCSV.Range("A2")

        'Paste Special
        .Range(.Cells(15, 1), .Cells(lLastRow, 10)).Copy
        With shtCSV.Range("A2")
            .PasteSpecial xlPasteValuesAndNumberFormats
            .PasteSpecial xlPasteFormats
        End With

        'Make the value of one cell equal the value of another cell
        'in a loop from row 15 to LastRow and column 1 to 10.
        'For x = 15 To lLastRow
        '    For y = 1 To 10
        '        shtCSV.Cells(x - 13, y) = .Cells(x, y)
        '    Next y
        'Next x

    End With

    wrkBk.SaveAs Environ("temp") & "/CSV File.csv", FileFormat:=xlCSV, CreateBackup:=False

End Sub

推荐阅读