(17)多表合并/分解,工作表事件等..StatusBar 狀態(tài)欄

時間劇毒 2015-01-16

展開全文

Sub 多表合并()
Dim i As Integer, rs As Integer, rss As Integer, st As Worksheet, zst As Worksheet
Set zst = Sheets("統(tǒng)計")
For i = 1 To 3
Set st = Sheets(i) ''表變量
'rs = st.UsedRange.Row.Count
' rss = zst.UsedRange.Row.Count
rs = st.Cells.Find("*", , , , , xlPrevious).Row   ''來源表有多少行
rss = zst.Cells.Find("*", , , , , xlPrevious).Row ''目標表的行數(shù)
st.Range("A2:B" & rs).Copy zst.Range("A" & rss + 1)
zst.Cells(rss + 1, 3).Resize(rs - 1) = i & "月" ''RS其中有列是列名
Next
End Sub
Sub 多表拆分()
s = Cells.Find("*", , , , , xlPrevious).Row
For i = 1 To 3
   Worksheets.Add.Name = i & "月"
   For Each rng In Range("a1:a" & s)
       If rng.Value = i & "月" Then
       y = y + 1

       If y = 1 Then ''y=1 時先復制標題
         Sheet4.Range("a1:c3").Copy Sheets(i & "月").Cells(y, 1)
       Else
         Sheet4.Range("a" & rng.Row & ":c" & rng.Row).Copy Sheets(i & "月").Cells(y, 1) ''當前的記錄
       End If

       End If
   Next
   y = 0   ''清零重新循環(huán) 符合下個條件的數(shù)據(jù)
Next
End Sub

Private Sub Worksheet_Activate() ''當工作表激活的時候

For Each sht In Sheets ''對工作表循環(huán)
If sht.Name <> "統(tǒng)計" Then ''在統(tǒng)計工作表中列出其他工作表的名稱
k = k + 1
Sheets("統(tǒng)計").Cells(k, 1) = sht.Name
End If

Next
End Sub

Private Sub Worksheet_Deactivate() ''離開工作表時狀態(tài)欄顯示
Application.StatusBar = "當前所選區(qū)域為:" '當離開工作表sheet4 的時候取消顯示
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) ''選擇改變觸發(fā)
If Target.Address = "$A$2" Or Target.Address = "$B$2" Or Target.Address = "$C$2" Then ''當選擇以上單元格時觸發(fā)
Target.Value = Target.Value + 1
End If

--計算公式直接賦值

Dim rs
rs = Application.CountA(Columns(1)) ''統(tǒng)計非空單元格
If Target.Address = Range("a1:a" & rs).Address Then
   For i = 1 To rs
    Cells(i, 2) = "=" & Cells(i, 1).Value
    Next
End If

''防止工作表名修改
If Sheets(4).Name <> "統(tǒng)計" Then
Sheets(4).Name = "統(tǒng)計"
End If
''application.staubar 屬性返回或設(shè)置狀態(tài)中的文字
'在狀態(tài)欄上顯示所選區(qū)域 ''address(0,0) '用相對引用的方式返回區(qū)域
Application.StatusBar = "當前所選區(qū)域為:" & Target.Address(0, 0)
''
If Intersect(Target, [a1:c12]) Is Nothing Then ''Intersect 交集 is nothing 沒有當所選區(qū)域與A1:c12 沒有交集就選擇A1
[a1].Select
End If

End Sub