VBA_ReportTools

Sub CombineAndCopyTextToA1()
    Dim selectedRange As Range
    Dim cell As Range
    Dim combinedText As String
    
    ' 检查是否有选定的单元格
    If Selection.Cells.Count < 8 Then
        MsgBox "请先选择至少八个单元格。", vbExclamation, "未选择足够的单元格"
        Exit Sub
    End If
    
    ' 初始化组合文本
    combinedText = ""
    
    ' 循环处理选定区域的前八个单元格的内容
    For Each cell In Selection.Cells
        combinedText = combinedText & cell.Value & "、"
        If cell.Column = Selection.Column + 7 Then ' 判断是否已处理完前八个单元格
            Exit For
        End If
    Next cell
    
    ' 去除末尾的逗号
    combinedText = Left(combinedText, Len(combinedText) - 1)
    
    ' 添加额外的文本
    combinedText = combinedText & "が上位で、その後" & Selection.Cells(5).Value & "、" & Selection.Cells(6).Value & "、" & Selection.Cells(7).Value & "と続く。" & vbCrLf & "属"" & ChrW(&H6027) & ChrW(&H5225) & ChrW(&H3067) & ChrW(&H307F) & ChrW(&H308B) & ChrW(&H3068)
    
    ' 将结果复制到单元格A1
    Range("A1").Value = combinedText
End Sub