0

我正在研究一个宏来提取收据数据，我只需要找到今天收据的数量。使用 IBM 终端，我打开了一个 Excel 工作表，然后继续让 IBM 进入我需要的屏幕，然后查看屏幕上的日期并将其与收据日期匹配。如果今天的日期与第一页上的收据日期不匹配，那么我需要让宏按 Enter，然后在第二页搜索匹配的日期，依此类推，直到日期匹配，或者一旦收据日期它们就永远不会停止为空白。我的代码如下。不知道打开函数在哪里不让代码完成。我是新手，不知道格式化代码，我提前道歉。

感谢您提供的任何帮助。

Sub RMBR()
  Dim infile As String
  Dim part As String * 19, COMMENT As String * 7, COMMENT2 As String * 2
  Dim TDATE As String * 7, PLANT As String * 1
  Dim source As String
  Dim SELECTION As Integer, i As Integer, c As String
  Dim Result As Single
  Dim excel As Object
  Dim ACELL As Single, BCELL As Single, CCELL As Single, dcell As Single
  Dim Verify As Single

  infile = InputBox$("input FILE NAME INCLUDING PATH?", "FILE NAME", "C:\CFILES\rmbr.XLSX")
  TDATE = InputBox$("Input Status", "TDATE", "CURRENT")
  
  i = 2
  Set excel = CreateObject("EXCEL.APPLICATION")
  excel.Visible = True
  excel.Workbooks.Open FileName:=infile
  Verify = MsgBox("IS THIS THE CORRECT SPREADSHEET?", 4, "VERIFY SPREADSHEET")
  ACELL = "A2"
  BCELL = "B2"
  CCELL = "C2"
  DCELL = "D2"
  
  excel.Range("A1").Select
  excel.activecell.FormulaR1C1 = "PARTNO"
  excel.Range("B1").Select
  excel.activecell.FormulaR1C1 = "RMBR QTY"
  excel.Range("C1").Select
  excel.activecell.FormulaR1C1 = " "
  excel.Range("D1").Select
  excel.activecell.FormulaR1C1 = "TODAY'S DATE"
  excel.Range(ACELL).Select
  part = excel.activecell.FormulaR1C1
  excel.Range(BCELL).Select
  PLANT = excel.activecell.FormulaR1C1
  excel.Range(CCELL).Select
  COMMENT = excel.activecell.FormulaR1C1
  excel.Range(dcell).Select
  COMMENT2 = excel.activecell.FormulaR1C1
  
  Do Until partnumber = "                "
    With Session
      .TransmitTerminalKey rcIBMClearKey
      .WaitForEvent rcKbdEnabled, "30", "0", 1, 1
      .WaitForEvent rcEnterPos, "30", "0", 1, 1
      .TransmitANSI "RMBR"
      .TransmitTerminalKey rcIBMEnterKey
      .WaitForEvent rcKbdEnabled, "30", "0", 1, 1
      '.WaitForEvent rcEnterPos, "30", "0", 2, 6
      .WaitForDisplayString "FN:", "30", 2, 2
      .MoveCursor 4, 11
      .TransmitANSI part
      .TransmitTerminalKey rcIBMEnterKey
      .WaitForEvent rcKbdEnabled, "30", "0", 1, 1
      Date = .GetDisplayText(4, 73, 8)
      RIP.Date = .GetDisplayText(9, 73, 8)
      
      Dim n As Integer
      For n = 9 To 22
        Do Until Date = RIP.Date
          Date = .GetDisplayText(9, 73, 8)
          RIP.Date = .GetDisplayText(n, 73, 8)
        Loop
        If Date = RIP.Date Then
          Result = .GetDisplayText(n, 32, 6)
          excel.Range(BCELL).Select
          excel.activecell.FormulaR1C1 = Result
        End If
        If Date <> RIP.Date Then
          .TransmitTerminalKey rcIBMEnterKey
        End If
        Do Until Date = RIP.Date
          Date = .GetDisplayText(9, 73, 8)
          RIP.Date = .GetDisplayText(n, 73, 8)
        Loop
        Do Until RIP.Date = "        "
        Loop
        
        i = i + 1
        c = Trim$(Str$(i))
        ACELL = "A" + c
        BCELL = "B" + c
        CCELL = "C" + c
        excel.Range(ACELL).Select
        part = excel.activecell.FormulaR1C1
        excel.Range(BCELL).Select
        PLANT = excel.activecell.FormulaR1C1
        excel.Range(CCELL).Select
        COMMENT = excel.activecell.FormulaR1C1
        excel.Range(dcell).Select
        COMMENT2 = excel.activecell.FormulaR1C1
    End With
End Sub
4

1 回答 1

0

您的代码中存在很多问题，让我们看一下：

很多这样的：

  excel.Range("A1").Select
  excel.activecell.FormulaR1C1 = "PARTNO"

您可以将其替换为（更具可读性）：

  excel.Range("A1").FormulaR1C1 = "PARTNO"

第一的：

  i = 2
  ACELL = "A2"

然后：

i = i + 1
c = Trim$(Str$(i))
ACELL = "A" + c

您也可以在开始时使用它，因此将第一个替换为：

i = 2
c = Trim$(Str$(i))
ACELL = "A" + c

For循环没有结束：

For n = 9 To 22
...
(Where's the Next, or the Step?)

可能的无限循环：

Do Until RIP.Date = "        "
Loop
(Two things: this is a possible endless loop, and second, what's with the list of spaces? You'd better say "... until Trim$(RIP.Date) = """)

大循环也没有结束：

Do Until partnumber = "                "
(same comment as above)

请进一步更正您的代码（因为您的代码甚至无法编译，几乎不可能进一步帮助您）。
最重要的是，我看到您正在混合使用小写字母和大写字母。在 Excel 中这不是问题，但其他编程语言可能会遇到问题。请养成对所有变量使用相同“大写”系统的好习惯。

于 2020-06-24T09:08:36.783 回答