hiko-blog

VBA業務改善

MENU

選択セルをセミコロン結合

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