kotaoueはそんなかんじ

kotaoueの最新情報。

VBA記念日

きょう、はじめてVBAを組んだ。
マクロとセキュリティが楽しいね。
VBA記念日
以下、は・じ・め・てのVBAを記念にアップ。
Excel VBA 入門講座参考にさせてもらって
40分ほどかかった。
Sub MakeList()
    MsgBox ("データを更新いたします。" & vbCr & "データ更新完了と出るまで、そのままでお待ちください")
    'シートを綺麗にする
    Worksheets("管理用").Activate
    Worksheets("管理用").Range("A1").EntireColumn.Delete
    
    '変数宣言
    Dim sheetLists(6) As String
    sheetLists(0) = "東京"
    sheetLists(1) = "大阪"
    sheetLists(2) = "名古屋"
    sheetLists(3) = "札幌"
    sheetLists(4) = "広島"
    sheetLists(5) = "福岡"
    
    Dim listRowNumber As Integer
    listRowNumber = 2
    
    Dim checkValue As Variant
    
    'PHP 配列書き出し
    Worksheets("管理用").Cells(1, 1).Value = "<?php $Status_Arr = Array("
    
    
    For sheetCount = 0 To 5
        For i = 2 To 65535
            checkValue = Worksheets(sheetLists(sheetCount)).Cells(i, 2).Value
            If Not IsEmpty(checkValue) And checkValue <> "担当者" And checkValue <> "○○" Then
                Worksheets("管理用").Cells(listRowNumber, 1).Value = "Array(" & _
                                                                    """" & Worksheets(sheetLists(sheetCount)).Cells(i, 3).Value & """," & _
                                                                    """" & Worksheets(sheetLists(sheetCount)).Cells(i, 4).Value & """," & _
                                                                    """" & Worksheets(sheetLists(sheetCount)).Cells(i, 5).Value & """," & _
                                                                    """" & Worksheets(sheetLists(sheetCount)).Cells(i, 6).Value & """," & _
                                                                    """" & Worksheets(sheetLists(sheetCount)).Cells(i, 7).Value & """," & _
                                                                    """" & Worksheets(sheetLists(sheetCount)).Cells(i, 8).Value & """," & _
                                                                    """" & Worksheets(sheetLists(sheetCount)).Cells(i, 9).Value & """),"
                listRowNumber = listRowNumber + 1
            End If
        Next
    Next
  
    
    Worksheets("管理用").Cells(listRowNumber, 1).Value = "); ?>"
    MsgBox ("データ更新完了")
End Sub



コメントはまだありません

コメントを残す

メールアドレスが公開されることはありません。