Sub 選択セルをセミコロン結合()
Dim rng As Range
Dim cell As Range
Dim result As String
' アクティブセル範囲を取得
Set rng = Selection
' セルの内容を結合
For Each cell In rng
If cell.Value <> "" Then
If result = "" Then
result = cell.Value
Else
result = result & ";" & cell.Value
End If
End If
Next cell
' B1セルに出力
Range("B1").Value = result
End Sub
Sub 選択セルをセミコロン結合2()
Dim rng As Range
Dim cell As Range
Dim result As String
' A列の範囲を取得(適当な終端行を指定)
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
' セルの内容を結合
For Each cell In rng
If cell.Value <> "" Then
If result = "" Then
result = cell.Value
Else
result = result & ";" & cell.Value
End If
End If
Next cell
' B1セルに出力
Range("B1").Value = result
End Sub
Sub SelectCellA1AndPasteFilePaths()
' ファイル選択ダイアログを表示してユーザーに複数のファイルを選ばせる
Dim filePaths As Variant
Dim i As Integer
Dim concatenatedPaths As String
filePaths = Application.GetOpenFilename("All Files (*.*), *.*," & _
"Excel Files (*.xls; *.xlsx), *.xls; *.xlsx," & _
"CSV Files (*.csv), *.csv," & _
"Text Files (*.txt), *.txt," & _
"PDF Files (*.pdf), *.pdf," & _
"ZIP Files (*.zip), *.zip", , "Select Files", MultiSelect:=True)
' ユーザーがキャンセルを押した場合
If IsArray(filePaths) Then
' ファイルパスを";"で区切って連結
For i = LBound(filePaths) To UBound(filePaths)
If concatenatedPaths = "" Then
concatenatedPaths = filePaths(i)
Else
concatenatedPaths = concatenatedPaths & ";" & filePaths(i)
End If
Next i
' シート"Sheet1"をアクティブにしてA1セルに連結したパスを転記
Sheets("Sheet1").Select
Range("A1").Value = concatenatedPaths
Else
MsgBox "No files were selected."
End If
End Sub