インクリメンタルな+1機能を開発する際の問題

Question

私はインクリメンタルな数字に問題があります。 「コードの最初の束」のこの部分を確認してください。

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

「コードの第2の束」に似た機能を実行しようとしています。 「コードの第2の束」：日付が今日の日付と等しい場合、数値が増分されます。たとえば、Excelシートを保存して閉じると、シートを再オープンすると[B2]が+1増加します。

私は（コードの最初の束に）この部分を作るために必要があるとして、私は、「コードの最初の束」のためにいくつかの時間のために立ち往生してきた

|" & combine & "|" 

の私の「最初の束のための出力コード」（単にサンプル）

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

出力File01.txtに保存され、ソースからである 『C：\ファイルHeader.xlsコードの第1の束』は、

『』、私は '結合'変数を作る必要がありますこれは、コードを保存せずにコードの2番目の束のような文字列の増分にあり、+1をインクリメンタル関数を実行するために再びExcelを閉じて再び開きます。私はボタンを押したときに、私は二度目のボタンを押すと は、第一の出力が生成される出力は（この部分は、以前のfile01.txtとしてfile01.txtに

00|?????|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 

話をしてきた「コードの最初の集まり」です）AJ_20161216_001が削除されます含まれています私は申し訳ありませんが、未組織形式のため、私の謝罪コード

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 

の最初の束のために実行する必要があり、同様の機能である「コードの2番目の集まり」です。

Answer 1

複雑なタスクは、メインサブルーチンから独自のサブルーチンに抽出する必要があります。

ここでは、IDを増やすためにgetNewIDを作成しました。

最後のセルの後ろに区切り記号を付けるべきではありません。これにより、空の列が作成され、ファイルを読む際に問題が発生します。

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