Question

我想在循环中间一列开始（比如说第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

我尝试将列引用（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的客户中，是物料/零件号。如果已填充这些行，则应填写新表单，直到原始表单中没有任何条目为止。

客户表格

Answer 1

我无法确切地找出您从哪里获取值以及将它们放在哪里，但是希望这段代码能给您足够的想法来整理您的值。

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

Answer 2

这花了很多简单的时间，它可以满足我的需要。代码：

'Fills column to last row of data from Cell C15
    Dim LastRow As Long
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("C15:C" & LastRow).FillDown
    Range("D15:D" & LastRow).FillDown
    Range("E15:E" & LastRow).FillDown

感谢所有答复。

选择执行循环的起始单元格

2 个答案: