开发增量+1功能的问题

时间:2016-12-15 18:17:28

标签: excel vba excel-vba

我有一组代码,我面临增量数字的问题。 请在“第一堆代码”上查看此部分,我需要帮助或指导我的卡住部分。

str = field1 & "|" & field2 & "|" & combine & "|"

我正在尝试做一些类似于我附加的“第二串代码”的功能。 “第二堆代码”:如果日期等于今天的日期,数字将增加增量,假设我保存excel表并关闭它,当我重新打开表(第二堆代码)时,数字[B2]会逐渐增加+1。

我已经被困在“第一批代码”中,因为我需要制作这部分(在第一批代码中)

|" & combine & "|"

我的“第一批代码”(只是一个样本)的输出是

00|?????|AJ_20161216_001|||||||||||||||||||||||||||

输出保存在File01.txt中,源代码来自“C:\ File Header.xls”

对于“第一批代码”,我需要制作'combine'变量,它在字符串增量中,就像第二串代码一样,没有保存并关闭excel并再次重新打开以执行增量函数+ 1。让我们说吧 当我按下按钮时,第一个输出将是

00|?????|AJ_20161216_001|||||||||||||||||||||||||||

当我第二次按下按钮时,生成的输出必须是(此部分也保存在file01.txt中,因为之前包含AJ_20161216_001的file01.txt将被删除)

00|?????|AJ_20161216_002|||||||||||||||||||||||||||

以下代码是我一直在谈论的“第一批代码”

Sub CreatePFHeaderFooter()
Dim myfile As String
//file location
myfile = "C:\File Header.xls"
Application.Workbooks.Open FileName:=myfile
DatFile1Name = ThisWorkbook.path + "\File01.txt"
Open DatFile1Name For Output As #1 'create csv file

//declaration of all cell into variable
vRow = 2
While Cells(vRow, 1).Value <> ""
field1 = Cells(vRow, 1).Value
field2 = Cells(vRow, 2).Value
Field3 = Format(Now(), "AJ""_""YYYYMMDD""_")
'realfield3 = Cells(vRow, 3).Value

field4 = Cells(vRow, 4).Value
field5 = Cells(vRow, 5).Value
field6 = Cells(vRow, 6).Value
field7 = Cells(vRow, 7).Value
field8 = Cells(vRow, 8).Value
field9 = Cells(vRow, 9).Value
field10 = Cells(vRow, 10).Value
field11 = Cells(vRow, 11).Value
field12 = Cells(vRow, 12).Value
field13 = Cells(vRow, 13).Value
field14 = Cells(vRow, 14).Value
field15 = Cells(vRow, 15).Value
field16 = Cells(vRow, 16).Value
field17 = Cells(vRow, 17).Value
field18 = Cells(vRow, 18).Value
field19 = Cells(vRow, 19).Value
field20 = Cells(vRow, 20).Value
field21 = Cells(vRow, 21).Value
field22 = Cells(vRow, 22).Value
field23 = Cells(vRow, 23).Value
field24 = Cells(vRow, 24).Value
field25 = Cells(vRow, 25).Value
field26 = Cells(vRow, 26).Value
field27 = Cells(vRow, 27).Value
field28 = Cells(vRow, 28).Value
field29 = Cells(vRow, 29).Value

//Incomplete parts
Dim str As String
Dim calc As Long
calc = 1 + 1
formcalc = Format(calc, "000")
combine = 0
combine1 = ""

//This is the part where i got stuck
If [C2] = "" Then
  combine = Field3 + formcalc
Else

str = ""
str = field1 & "|" & field2 & "|" & combine & "|" & field4 & "|" & field5 & "|" & field6 & "|" & field7 & "|" & field8 & "|" & field9 & "|" & field10 & "|"
str = str & field11 & "|" & field12 & "|" & field13 & "|" & field14 & "|" & field15 & "|" & field16 & "|" & field17 & "|" & field18 & "|" & field19 & "|" & field20 & "|"
str = str & field21 & "|" & field22 & "|" & field23 & "|" & field24 & "|" & field25 & "|" & field26 & "|" & field27 & "|" & field28 & "|" & field29 & "|"


Print #1, str
vRow = vRow + 1

Wend
Close #1

ActiveWorkbook.Close

这是“第二堆代码”,它是我需要为第一批代码做的类似功能

Private Sub Workbook_Open()

If [B1] = "" Then
    [B1] = Format(Now(), "dd/mm/yyyy")
    [B2] = 1
Else
    If Trim([B1]) <> Format(Now(), "dd/mm/yyyy") Then
        [B1] = Format(Now(), "dd/mm/yyyy")
        [B2] = 1
Else
    [B1] = Format(Now(), "dd/mm/yyyy")
    [B2] = [B2] + 1
End If
End If

End Sub

抱歉,我为无组织的格式道歉。

1 个答案:

答案 0 :(得分:1)

复杂的任务应该从主子程序中提取到它们自己的子程序中。

在这里,我创建了getNewID来增加ID。

在最后一个单元格后面不应该有分隔符。这将创建一个空列,这将导致读取文件的问题。

  

str = field1&amp; “|” &安培; ......&amp; field29&amp; “|”

Sub CreatePFHeaderFooter()

    Dim x As Long, y As Long
    Dim data(1 To 29) As String
    Dim myfile As String
    'file location
    myfile = "C:\File Header.xls"
    Application.Workbooks.Open Filename:=myfile
    DatFile1Name = ThisWorkbook.Path + "\File01.txt"
    Open DatFile1Name For Output As #1    'create csv file

    x = 2
    While Cells(x, 1).Value <> ""

        If Cells(x, 3) = "" Then Cells(x, 3) = getNewID(Cells(x - 1, 3))

        For y = 1 To 28
            data(y) = Cells(x, y)
        Next

        Print #1, Join(data, "|")
        x = x + 1
    Wend

    Close #1

    ActiveWorkbook.Close
End Sub

Function getNewID(OldID As String) As String
    Dim arr() As String, strDate As String
    Dim d As Date

    arr = Split(OldID, "_")
    strDate = arr(1)
    d = DateSerial(Left(strDate, 4), Mid(strDate, 5, 2), Right(strDate, 2))

    If d = Date Then
        arr(2) = Format(CInt(arr(3)) + 1, "000")
    Else
        arr(1) = Format(Date, "yyyymmdd")
        arr(2) = "001"
    End If

    getNewID = Join(arr, "_")
End Function
相关问题