ExcelVBA：ゲーム開発者が使えるマクロ5選

Sub CheckDuplicatesAndBlanks()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet

Dim checkCol As Range
Set checkCol = ws.Range(“A2:A100”)

Dim cell As Range
Dim dupCount As Integer
dupCount = 0

For Each cell In checkCol
‘ Skip empty rows
If IsEmpty(cell.Value) Then
cell.Interior.Color = RGB(255, 255, 0)
dupCount = dupCount + 1
End If

‘ Check duplicate
If WorksheetFunction.CountIf(checkCol, cell.Value) > 1 Then
If Not IsEmpty(cell.Value) Then
cell.Interior.Color = RGB(255, 150, 150)
dupCount = dupCount + 1
End If
End If
Next cell

If dupCount = 0 Then
MsgBox “No issues found!”
Else
MsgBox dupCount & ” issue(s) found. Please check highlighted cells.”
End If
End Sub

EnemyID

HP

ATK

E001

100

30

E002

300

45

| EnemyID | HP | ATK |
|—|—|—|
| E001 | 100 | 30 |
| E002 | 300 | 45 |

Sub CopyAsMarkdownTable()
Dim sel As Range
Set sel = Selection

If sel Is Nothing Then
MsgBox “Please select a range first.”
Exit Sub
End If

‘ Load selection into array
Dim arrData As Variant
arrData = sel.Value

Dim lastRow As Long
Dim lastCol As Long
lastRow = UBound(arrData, 1)
lastCol = UBound(arrData, 2)

Dim arrOut() As String
ReDim arrOut(0)

Dim r As Long, c As Long

‘ Header row
Dim headerCols() As String
ReDim headerCols(1 To lastCol)
For c = 1 To lastCol
headerCols(c) = CStr(arrData(1, c))
Next c
arrOut(0) = “| “ & Join(headerCols, ” | “) & ” |”

‘ Separator row
ReDim Preserve arrOut(UBound(arrOut) + 1)
Dim sepCols() As String
ReDim sepCols(1 To lastCol)
For c = 1 To lastCol
sepCols(c) = “—“
Next c
arrOut(UBound(arrOut)) = “| “ & Join(sepCols, ” | “) & ” |”

‘ Data rows
For r = 2 To lastRow
Dim rowCols() As String
ReDim rowCols(1 To lastCol)
For c = 1 To lastCol
rowCols(c) = CStr(arrData(r, c))
Next c
ReDim Preserve arrOut(UBound(arrOut) + 1)
arrOut(UBound(arrOut)) = “| “ & Join(rowCols, ” | “) & ” |”
Next r

‘ Copy to clipboard
Dim result As String
result = Join(arrOut, vbCrLf)

With CreateObject(“Forms.TextBox.1”)
.MultiLine = True
.Text = result
.SelectAll
.Copy
End With

MsgBox “Copied as Markdown table! (“ & lastRow & ” rows)”
End Sub

Sub ListFilesInFolder()
Dim folderPath As String
folderPath = InputBox(“Enter folder path:”, “Folder Path”)

If folderPath = “” Then Exit Sub

Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
ws.Cells.Clear

‘ Header
ws.Cells(1, 1).Value = “FileName”
ws.Cells(1, 2).Value = “Extension”
ws.Cells(1, 3).Value = “FullPath”

Dim fileName As String
Dim row As Long
row = 2

fileName = Dir(folderPath & “\*.*”)
Do While fileName <> “”
ws.Cells(row, 1).Value = fileName
ws.Cells(row, 2).Value = LCase(Right(fileName, Len(fileName) – InStrRev(fileName, “.”)))
ws.Cells(row, 3).Value = folderPath & “\” & fileName
row = row + 1
fileName = Dir()
Loop

MsgBox “Found “ & row – 2 & ” file(s)!”
End Sub

Sub GenerateLocalizationSheet()
Dim wsSrc As Worksheet
Dim wsLoc As Worksheet
Set wsSrc = ThisWorkbook.ActiveSheet

‘ Languages to add
Dim langs As Variant
langs = Array(“EN”, “ZH”, “KO”)

‘ Create or clear Localization sheet
On Error Resume Next
Set wsLoc = ThisWorkbook.Sheets(“Localization”)
On Error GoTo 0

If wsLoc Is Nothing Then
Set wsLoc = ThisWorkbook.Sheets.Add
wsLoc.Name = “Localization”
Else
wsLoc.Cells.Clear
End If

‘ Header
wsLoc.Cells(1, 1).Value = “ID”
wsLoc.Cells(1, 2).Value = “JA”

Dim i As Integer
For i = 0 To UBound(langs)
wsLoc.Cells(1, 3 + i).Value = langs(i)
Next i

‘ Copy ID and JA columns from source
Dim lastRow As Long
lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row

wsSrc.Range(“A2:B” & lastRow).Copy wsLoc.Range(“A2”)

MsgBox “Localization sheet generated!”
End Sub

Sub ExportToCSV()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet

Dim filePath As String
filePath = ThisWorkbook.Path & “\” & ws.Name & “.csv”

Dim lastRow As Long
Dim lastCol As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

‘ Load to array (faster than Range access)
Dim arrData As Variant
arrData = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value

Dim arrOut() As String
ReDim arrOut(1 To lastRow)

Dim r As Long, c As Long
For r = 1 To lastRow
Dim rowData() As String
ReDim rowData(1 To lastCol)
For c = 1 To lastCol
rowData(c) = CStr(arrData(r, c))
Next c
arrOut(r) = Join(rowData, “,”)
Next r

‘ Write UTF-8
With CreateObject(“ADODB.Stream”)
.Charset = “UTF-8”
.Open
.WriteText Join(arrOut, vbCrLf), 1
.SaveToFile filePath, 2
.Close
End With

MsgBox “CSV exported: “ & filePath
End Sub

#

マクロ名

使いどころ

①

空白・重複チェック

IDの入力ミスを防ぐ

②

Markdown表に変換してコピー

GitHubへのコピペ

③

ファイル名一覧化

アセット管理の自動化

④

ローカライズ生成

翻訳作業の準備を効率化

⑤

CSV出力

Unityへのデータ渡し