麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
Sub Ex()
Dim Rng As Range, E As Range
With ActiveSheet
Set Rng = .Range("C:C").SpecialCells(xlCellTypeBlanks)
For Each E In Rng.Areas
If E.Cells(E.Rows.Count).Row < .Rows.Count Then
E.Cells(1) = E.Cells(E.Rows.Count + 1)
E.Cells(E.Rows.Count + 1) = ""
End If
Next
End With
End Sub

複製代碼

Worksheets("Sheet1").Range("c12").End(xlDown).SpecialCells(xlCellTypeBlanks)

複製代碼

Sub Ex()
Dim Rng As Range, E As Range
With ActiveSheet
Set Rng = .Range("C12:C23").SpecialCells(xlCellTypeBlanks)
For Each E In Rng.Areas
If E.Cells(E.Rows.Count).Row < 23 Then
E.Cells(1) = E.Cells(E.Rows.Count + 1)
E.Cells(E.Rows.Count + 1) = ""
End If
Next
End With
End Sub

複製代碼

Option Explicit
Sub Ex()
Dim Rng As Range, E As Range, lastrow As Long
With ActiveSheet
lastrow = Worksheets("sheet1").Range("a12").End(xlDown).Row
Set Rng = .Range("a12:L" & lastrow&).SpecialCells(xlCellTypeBlanks)
For Each E In Rng.Areas
If E.Cells(E.Rows.Count).Row < .Rows.Count Then
E.Cells(1) = E.Cells(E.Rows.Count + 1)
E.Cells(E.Rows.Count + 1) = ""
End If
Next
End With
End Sub

複製代碼

Sub autopl()
Dim i As Long
Dim MyString, myLen
For i = 15 To [a65536].End(4).Row
MyString = Cells(i, 2)
If Len(MyString) = 10 Then
Cells(i, 9).FormulaR1C1 = ""
Cells(i, 10).FormulaR1C1 = ""
Cells(i, 11).FormulaR1C1 = ""
End If
Next i
Ex
Ex2
Ex3
Ex4
add1
ctn1
End Sub
Sub Ex()
Dim Rng As Range, E As Range, lastrow3 As Long
With ActiveSheet
lastrow3 = Worksheets("sheet1").Range("a15").End(xlDown).Row
Set Rng = .Range("J15:J" & lastrow3&).SpecialCells(xlCellTypeBlanks)
For Each E In Rng.Areas
If E.Cells(E.Rows.Count).Row < .Rows.Count Then
E.Cells(1) = E.Cells(E.Rows.Count + 1)
E.Cells(E.Rows.Count + 1) = ""
End If
Next
End With
End Sub
Sub Ex2()
Dim Rng2 As Range, D As Range, lastrow2 As Long
With ActiveSheet
lastrow2 = Worksheets("sheet1").Range("a15").End(xlDown).Row
Set Rng2 = .Range("I15:I" & lastrow2&).SpecialCells(xlCellTypeBlanks)
For Each D In Rng2.Areas
If D.Cells(D.Rows.Count).Row < .Rows.Count Then
D.Cells(1) = D.Cells(D.Rows.Count + 1)
D.Cells(D.Rows.Count + 1) = ""
End If
Next
End With
End Sub
Sub Ex3()
Dim Rng3 As Range, f As Range, lastrow5 As Long
With ActiveSheet
lastrow5 = Worksheets("sheet1").Range("a15").End(xlDown).Row
Set Rng3 = .Range("k15:k" & lastrow5&).SpecialCells(xlCellTypeBlanks)
For Each f In Rng3.Areas
If f.Cells(f.Rows.Count).Row < .Rows.Count Then
f.Cells(1) = f.Cells(f.Rows.Count + 1)
f.Cells(f.Rows.Count + 1) = ""
End If
Next
End With
End Sub
Sub Ex4()
Dim rw As Long
For rw = 15 To [a65536].End(4).Row
If Cells(rw, 2).Value = 1 Then Cells(rw, 2).EntireRow.Delete
Next rw
End Sub
Sub add1()
Dim l As Long
For l = 15 To [a65536].End(4).Row
If Cells(l, 2) <> "" Then
Cells(l, 2).FormulaR1C1 = ""
End If
Next l
End Sub
Sub ctn1()
Dim lastrow4 As Long
With ActiveSheet
lastrow4 = Worksheets("sheet1").Range("a15").End(xlDown).Row
Range("b15").FormulaR1C1 = "0"
Range("b16").FormulaR1C1 = "=IF(RC[7]="""",R[-1]C,R[-1]C+1)"
Range("b16").AutoFill Destination:=Range("b16:b" & lastrow4)
End With
End Sub

複製代碼

Sub ex()
Dim A As Range, B As Range, Rng As Range
With Sheet1
Set Rng = .Range("A:A").Find("DATA1", lookat:=xlWhole) '找A欄標題列位置
If Not Rng Is Nothing Then
If Application.Count(Rng.CurrentRegion.Columns(3)) > 0 Then '資料C欄數值數量判斷
For Each A In Rng.CurrentRegion.Columns(3).SpecialCells(xlCellTypeConstants, 1) '每個數值做迴圈
Set B = Rng.CurrentRegion.Columns(2).Find(A.Offset(, -2), lookat:=xlWhole) '找到B欄第一個位置
If Not B Is Nothing Then A.Cut B.Offset(, 1) '移動位置
Next
End If
End If
End With
End Sub

複製代碼