使えそうなエクセルマクロの色々

複数ファイルの一部分を結合して一つのファイルにする

Sub MergeFiles()
    Dim fDialog As FileDialog
    Dim wbDest As Workbook
    Dim wbSrc As Workbook
    Dim wsDest As Worksheet
    Dim wsSrc As Worksheet
    Dim i As Long
    Dim lRow As Long
    Dim lCol As Long

    'ファイル選択ダイアログを表示し、選択されたファイルを取得
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "Select files to merge"
        If .Show = -1 Then
            '結合先のワークブックを作成
            Set wbDest = Workbooks.Add
            Set wsDest = wbDest.Sheets(1)
            wsDest.Name = "Merged Data"

            '選択されたファイルを1つずつ読み込んで、結合先シートに貼り付け
            For i = 1 To .SelectedItems.Count
                Set wbSrc = Workbooks.Open(.SelectedItems(i))
                Set wsSrc = wbSrc.Sheets(1)

                '結合先シートの最終行を取得
                lRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
                lCol = wsDest.Cells(1, wsDest.Columns.Count).End(xlToLeft).Column

                '選択されたシートの2行目から最終行までを結合先シートに貼り付け
                wsSrc.Range("A2:Z" & wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row).Copy _
                Destination:=wsDest.Cells(lRow + 1, 1)
                
                wbSrc.Close False
            Next i

            wbDest.SaveAs "Merged Data.xlsx"
        End If
    End With
End Sub

3つのコンボボックスで選択されたシートを取得し、それらを新しいシートに順にコピーして貼り付け

Private Sub CommandButton1_Click()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, wsNew As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
    Set ws1 = ThisWorkbook.Sheets(ComboBox1.Value)
    Set ws2 = ThisWorkbook.Sheets(ComboBox2.Value)
    Set ws3 = ThisWorkbook.Sheets(ComboBox3.Value)
    Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsNew.Name = "Concatenated Sheets"
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    lastRow3 = ws3.Cells(ws3.Rows.Count, 1).End(xlUp).Row
    ws1.Range("A1:A" & lastRow1).Copy wsNew.Range("A1")
    ws2.Range("A1:A" & lastRow2).Copy wsNew.Range("A" & lastRow1 + 1)
    ws3.Range("A1:A" & lastRow3).Copy wsNew.Range("A" & lastRow1 + lastRow2 + 1)
End Sub

Function kanjiToKatakana(ByVal kanji As String) As String
    Dim i As Integer
    Dim result As String
    
    For i = 1 To Len(kanji)
        Select Case Mid(kanji, i, 1)
            Case "一"
                ' 二桁または三桁数字の場合
                If (i + 1 <= Len(kanji) And Mid(kanji, i + 1, 1) = "一") Or (i + 2 <= Len(kanji) And Mid(kanji, i + 1, 1) = "五" And Mid(kanji, i + 2, 1) = "一") Then
                    Select Case Mid(kanji, i, 1)
                        Case "一"
                            result = result & "イチ"
                            i = i + 1
                            ' 一五一の場合
                            If (i + 1 <= Len(kanji) And Mid(kanji, i + 1, 1) = "五" And Mid(kanji, i + 2, 1) = "一") Then
                                result = result & "ゴ"
                                i = i + 1
                            End If
                            result = result & "チ"
                        Case "五"
                            result = result & "ゴ"
                            i = i + 1
                            result = result & "チ"
                    End Select
                Else
                    result = result & "イチ"
                End If
            Case "二"
                result = result & "ニ"
            Case "三"
                result = result & "サン"
            Case "四"
                result = result & "シ"
            Case "五"
                result = result & "ゴ"
            Case "六"
                result = result & "ロク"
            Case "七"
                result = result & "シチ"
            Case "八"
                result = result & "ハチ"
            Case "九"
                result = result & "キュウ"
            Case "十"
                result = result & "ジュウ"
            Case Else
                ' その他の文字はそのまま出力
                result = result & Mid(kanji, i, 1)
        End Select
    Next i
    
    kanjiToKatakana = result
End Function

=LEFT(A1,1)&IF(RAND()<0.5,"",".")&MID(A1,2,1)&IF(RAND()<0.5,"",".")&MID(A1,3,1)&IF(RAND()<0.5,"",".")&MID(A1,4,1)&IF(RAND()<0.5,"",".")&MID(A1,5,1)&IF(RAND()<0.5,"",".")&MID(A1,6,1)&IF(RAND()<0.5,"",".")&MID(A1,7,1)&IF(RAND()<0.5,"",".")&MID(A1,8,1)&IF(RAND()<0.5,"",".")&MID(A1,9,1)&IF(RAND()<0.5,"",".")&MID(A1,10,1)&IF(RAND()<0.5,"",".")&RIGHT(A1,1)