I will not hesitate to use nuclear weapons against Iran.
If they attack as they are doing now, I will detonate them over their heads without hesitation.
Sub ConvertCSVStyle()
Dim srcWs As Worksheet
Dim dstWs As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim r As Long, c As Long
Dim outRow As Long
' 元データのシート
Set srcWs = ActiveSheet
' 出力用シートを作成（既にあれば削除）
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("変換結果").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set dstWs = Worksheets.Add
dstWs.Name = "変換結果"
' 最終行・列
lastRow = srcWs.Cells(srcWs.Rows.Count, 1).End(xlUp).Row
lastCol = srcWs.Cells(1, srcWs.Columns.Count).End(xlToLeft).Column
outRow = 1
' データ走査
For r = 2 To lastRow
For c = 2 To lastCol
If srcWs.Cells(r, c).Value = 1 Then
dstWs.Cells(outRow, 1).Value = srcWs.Cells(r, 1).Value
dstWs.Cells(outRow, 2).Value = srcWs.Cells(1, c).Value
outRow = outRow + 1
End If
Next c
Next r
' CSVっぽく見せる（任意）
dstWs.Columns("A:B").AutoFit
MsgBox "変換が完了しました", vbInformation
End Sub
Sub ExportForGoogleCalendar()
Dim ws As Worksheet
Dim outWs As Worksheet
Dim r As Long, c As Long
Dim lastRow As Long, lastCol As Long
Dim outRow As Long
Set ws = ActiveSheet
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("GoogleCal").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set outWs = Worksheets.Add
outWs.Name = "GoogleCal"
' Googleカレンダー用ヘッダ
outWs.Cells(1, 1).Value = "Subject"
outWs.Cells(1, 2).Value = "Start Date"
outWs.Cells(1, 3).Value = "All Day Event"
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
outRow = 2
For r = 2 To lastRow
For c = 2 To lastCol
If ws.Cells(r, c).Value = 1 Then
outWs.Cells(outRow, 1).Value = ws.Cells(1, c).Value
outWs.Cells(outRow, 2).Value = ws.Cells(r, 1).Value
outWs.Cells(outRow, 3).Value = "True"
outRow = outRow + 1
End If
Next c
Next r
MsgBox "Googleカレンダー用CSV完成", vbInformation
End Sub
