vba misc 合并表、循环。

Option Explicit

'在第7列加上表名
Sub autoadd()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
    ws.Cells(2, 7).Value = "Country"
    ws.Select
    Dim rn As Range
    ws.Range(ws.Cells(3, 7), Cells(ws.UsedRange.Rows.Count, 7)).Value = ws.Name

Next

End Sub

'合并到一起
Sub t3()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> "compile" Then
    ws.Rows("2:" & ws.UsedRange.Rows.Count).Copy Worksheets("compile").Range("a6536").End(xlUp).Offset(2, 0)
    End If
Next
End Sub

'检查选中区域是不是有空格
Sub checkblank()

Dim rn As Range

For Each rn In Selection
    If Len(rn) = 0 And Len(rn.Offset(0, 1)) = 0 And Len(rn.Offset(0, 2)) = 0 And Len(rn.Offset(0, 3)) = 0 Then
    rn.Offset(0, 6).Value = 1
    End If

Next

End Sub

'合并单元格 函数

Function tx(rn As Range) As String

Dim str As String
Dim rnn As Range

For Each rnn In rn

If Len(rnn) > 0 Then
    str = str & rnn.Text & vbCrLf '加上回车换行
    End If
Next
str = Left(str, Len(str) - Len(vbCrLf))
'去掉最后一个回车空格
tx = str

End Function

'合并单元格 过程
Sub ctx()

Dim comstr As String
comstr = tx(Selection)

Dim rnn As Range
For Each rnn In Selection
    rnn = ""
Next
Selection.Cells(1, 1) = comstr

End Sub