- 帖子
- 38
- 主題
- 12
- 精華
- 0
- 積分
- 122
- 點名
- 0
- 作業系統
- winxp
- 軟體版本
- office2003
- 閱讀權限
- 20
- 性別
- 男
- 來自
- na
- 註冊時間
- 2010-7-31
- 最後登錄
- 2024-5-13
|
請教各位前輩關於VB 一些問題
我想問題問題如圖所示:
我所寫的程式如下:
' Macro11 巨集表
'
Dim i As Single
Dim j As Single
Dim k As Single
Dim h As Single
Dim x As Range, Y As Range, rng As Range, r As Long '宣告變數
For j = 1 To 3
For i = 1 To 300
If Cells(1 + i, 38) = Cells(1, 52 + j) Then
Cells(1 + i, 52 + j) = Cells(1 + i, 8)
End If
Next i
Next j
Call tt
End Sub
Public Sub tt()
Dim x As Range, Y As Range, rng As Range, r As Long '宣告變數
Dim y1 As Range, y2 As Range
For h = 1 To 3
r = Cells(65536, 52 + h).End(xlUp).Row '取的A欄最大列位
Select Case h
Case 1
Set rng = Range("ba2:ba" & r) '取得資料範圍
For Each x In rng '資料範圍內每一儲存格
If x = "" Then '若儲存格值為""
If Y Is Nothing Then 'Y若不存在
Set Y = x '將Y設定為x
Else '若Y存在
Set Y = Union(Y, x) '結合Y及x成為新的範圍Y
End If
End If
Next
If Not Y Is Nothing Then Y.Delete (xlUp) '若Y存在將Y刪除
Case 2
Set rng = Range("bb2:bb" & r) '取得資料範圍
For Each x In rng '資料範圍內每一儲存格
If x = "" Then '若儲存格值為""
If y1 Is Nothing Then 'Y若不存在
Set y1 = x '將Y設定為x
Else '若Y存在
Set y1 = Union(y1, x) '結合Y及x成為新的範圍Y
End If
End If
Next
If Not y1 Is Nothing Then y1.Delete (xlUp) '若Y存在將Y刪除
Case 3
Set rng = Range("bc2:bc" & r) '取得資料範圍
For Each x In rng '資料範圍內每一儲存格
If x = "" Then '若儲存格值為""
If y2 Is Nothing Then 'Y若不存在
Set y2 = x '將Y設定為x
Else '若Y存在
Set y2 = Union(y2, x) '結合Y及x成為新的範圍Y
End If
End If
Next
If Not y2 Is Nothing Then y2.Delete (xlUp) '若Y存在將Y刪除
End Select
Next h
End Sub
我想問的題題如圖所示:
|
|
發表於 2010-8-4 22:37
| 
