タグ: recipe

In this article, I’d like to describe how to fix the text file of the food composition of the diet recipes, which a facility have provided for one year, to the first normal form in order to insert into database.

Option Explicit

Sub LoopProcedure()
    Dim Sh  As Worksheet
    For Each Sh In Worksheets
        If Sh.Name Like "Sheet" & "*" Then
            Call TransportFromTxtToCSV(Sh)
        End If
    Next Sh
End Sub

Sub TransportFromTxtToCSV()
    Dim mySht               As Worksheet
    Dim myRng               As Range
    Dim myAr                As Variant
    Dim RecAr()             As String
    Dim i                   As Long
    Dim j                   As Long
    Dim k                   As Long
    Dim Date_Serving_Meal   As Date
    Dim Menu_Name           As String
    Dim tmpStart            As Long
    Dim Meal_Time           As String
    Dim Dish                As String
    Dim RecordNumber        As Long
    
    set mysht = sh
    RecordNumber = Count_Record(mySht)
    ReDim RecAr(RecordNumber - 1, 51)
    Set myRng = mySht.UsedRange
    myAr = myRng
    k = 0
    Date_Serving_Meal = "2011/1/1"
    Menu_Name = myAr(1, 11) & myAr(1, 12) & myAr(1, 13)
    tmpStart = InStr(Menu_Name, ")")
    Menu_Name = Mid(Menu_Name, tmpStart + 1)
    Meal_Time = "朝食"
    For i = LBound(myAr) To UBound(myAr)
        
        Select Case True
            Case myAr(i, 2) = "合      計"
                Date_Serving_Meal = DateAdd("d", 1, Date_Serving_Meal)
            Case myAr(i, 2) = "《朝食》"
                Meal_Time = "朝食"
            Case myAr(i, 2) = "《昼食》"
                Meal_Time = "昼食"
            Case myAr(i, 2) = "《夕食》"
                Meal_Time = "夕食"
            Case myAr(i, 2) = "小      計"
            Case myAr(i, 2) = "^e12【献立"
            Case myAr(i, 2) Like "動蛋比" & "*"
            Case myAr(i, 2) = "・・・・・・・・・・"
            Case myAr(i, 2) = "料理名"
            Case myAr(i, 2) = ""
            Case Else
                Dish = myAr(i, 2)
        End Select
        
        Select Case True
            Case myAr(i, 3) = "・・・・・・・・・・・"
            Case myAr(i, 3) Like "EN比" & "*"
            Case myAr(i, 3) = "食品名"
            Case myAr(i, 3) Like "一覧表】 ^e11" & "*"
            Case myAr(i, 3) = ""
            Case Else
                RecAr(k, 0) = Date_Serving_Meal
                RecAr(k, 1) = Menu_Name
                RecAr(k, 2) = Meal_Time
                RecAr(k, 3) = Dish
                RecAr(k, 4) = myAr(i, 3)
                For j = 5 To 22
                    RecAr(k, j) = myAr(i, j - 1)
                Next j
                For j = 23 To 39
                    RecAr(k, j) = myAr(i + 1, j - 18)
                Next j
                For j = 40 To 51
                    RecAr(k, j) = myAr(i + 2, j - 35)
                Next j
                k = k + 1
        End Select
    Next i
    Set mySht = Worksheets.Add
    With mySht
        .Name = Menu_Name
        .Range(Cells(1, 1), Cells(RecordNumber, 52)) = RecAr
    End With
    
    Set mySht = Nothing
    Set myRng = Nothing
    Erase RecAr
End Sub

Function Count_Record(ByRef Sh As Worksheet) As Long    
    Dim mySht       As Worksheet
    Dim myAr        As Variant
    Dim i           As Long
    Dim j           As Long
    Dim k           As Long
    Set mySht = Sh
    myAr = mySht.UsedRange
    j = 0
    k = 0
    For i = LBound(myAr) To UBound(myAr)
        Select Case True
            Case myAr(i, 2) = "合      計"
            Case myAr(i, 2) = "小      計"
            Case myAr(i, 2) = "《朝食》"
            Case myAr(i, 2) = "《昼食》"
            Case myAr(i, 2) = "《夕食》"
            Case myAr(i, 2) = "^e12【献立"
            Case myAr(i, 2) Like "動蛋比" & "*"
            Case myAr(i, 2) = "・・・・・・・・・・"
            Case myAr(i, 2) = "料理名"
            Case myAr(i, 2) = ""
            Case Else
                j = j + 1
        End Select
        Select Case True
            Case myAr(i, 3) = "・・・・・・・・・・・"
            Case myAr(i, 3) Like "EN比" & "*"
            Case myAr(i, 3) = "食品名"
            Case myAr(i, 3) Like "一覧表】 ^e11" & "*"
            Case myAr(i, 3) = ""
            Case Else
                k = k + 1
        End Select
    Next i
    Count_Record = k
End Function