2016-12-15 36 views
-1

我有一套代码,我正面临增量数字问题。 请检查这部分的“第一批代码”,我需要帮助或指导我卡住的部分。开发增量+1功能的问题

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

我想做一些类似于我附加的“第二批代码”的函数。 “第二批代码”:如果日期等于今天的日期,则数字将增加,例如,如果我保存Excel表格并关闭它,当我重新打开表格(第二批代码)时,数字因为[B2]会递增+1。

我已经坚持了一段时间的“第一束代码”,因为我需要让这部分(第一一堆代码)

|" & combine & "|" 

输出为我的“第一次帮代码”(只是一个例子)是

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

输出被保存在File01.txt和源是从‘C:\文件Header.xls’

对于‘第一束代码’,我需要制作'联合'变量这是字符串增量像第二组代码没有保存并关闭Excel并重新打开它再次执行+1的增量功能。让说 当我按下按钮,第一个输出将

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

当我按下了第二次按钮生成的输出必须(这部分也保存在file01.txt如前file01.txt包含AJ_20161216_001将被删除)

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 

对不起要做,我的无组织的格式道歉。

+0

'calc'有它的被保留值的子以外的声明。 – Slai

+0

好吧,指出,我会做出更正 –

回答

1

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

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

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

str = field1 & "|" & ... & field29 & "|"

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 
+0

@lyeyannian是'getNewID'在一个标准的模块? – 2016-12-16 01:25:53

+0

嗨,忽略这个问题,我已经解决了它,现在我遇到了最后一个问题,如果我在函数getnewID结束后添加messagebox,我会得到编译错误:只有注释可能出现在结束子,结束函数,或结束财产。 –

+0

@lyeyannian你应该看这个系列:[Excel VBA介绍](https://www.youtube.com/playlist?列表= PLNIs-AWhQzckr8Dgmgb3akx_gFMnpxTN5)。这是相当重要的:[Excel VBA简介第3部分 - 如何处理事情出错(错误和调试)](https://www.youtube.com/watch?v=DlqKfYTgc9Q&index=3&list=PLNIs-AWhQzckr8Dgmgb3akx_gFMnpxTN5&t=40s) – 2016-12-16 02:00:09