php控制vba,菜鸟谈VBA最最基础入门《原创》

Sub fenlei()

Dim hm As Worksheet, wc As Worksheet, zj As Worksheet, lc As Worksheet, wz As Worksheet, ql As Worksheet, hf As Worksheet, sw As Worksheet

Set hm = Worksheets("外在本就读花名册")

Set wc = Worksheets("卫城")

Set zj = Worksheets("站街")

Set lc = Worksheets("流长")

Set wz = Worksheets("王庄")

Set ql = Worksheets("青龙")

Set hf = Worksheets("红枫")

Set sw = Worksheets("清镇市外")

lastRow = hm.[A65535].End(xlUp).Row

lastColumn = hm.[A2].End(xlToRight).Column

' xian = hm.Range(hm.Cells(2, 1), hm.Cells(2, lastColumn)).Find("县").Column

xian = hm.Rows(2).Find("县").Column

' xiang = hm.Range(hm.Cells(2, 1), hm.Cells(2, lastColumn)).Find("乡").Column

xiang = hm.Rows(2).Find("乡").Column

wc.Range(wc.Cells(3, 1), wc.Cells(65536, lastColumn)).Clear

zj.Range(zj.Cells(3, 1), zj.Cells(65536, lastColumn)).Clear

lc.Range(lc.Cells(3, 1), lc.Cells(65536, lastColumn)).Clear

wz.Range(wz.Cells(3, 1), wz.Cells(65536, lastColumn)).Clear

ql.Range(ql.Cells(3, 1), ql.Cells(65536, lastColumn)).Clear

hf.Range(hf.Cells(3, 1), hf.Cells(65536, lastColumn)).Clear

sw.Range(sw.Cells(3, 1), sw.Cells(65536, lastColumn)).Clear

For i = 3 To lastRow

rangeIxian = hm.Cells(i, xian).Value

If rangeIxian <> "清镇" Then

' hm.Range(hm.Cells(i, 1), hm.Cells(i, lastColumn)).Copy sw.Cells(sw.[A65535].End(xlUp).Row + 1, 1)

j = sw.[A65535].End(xlUp).Row + 1

hm.Rows(i).Copy sw.Rows(j)

sw.Cells(j, 1).Value = j - 2

Else

rangeIxiang = hm.Cells(i, xiang)

Select Case rangeIxiang

Case "卫城"

j = wc.[A65535].End(xlUp).Row + 1

' hm.Range(hm.Cells(i, 1), hm.Cells(i, lastColumn)).Copy wc.Cells(j, 1)

hm.Rows(i).Copy wc.Rows(j)

wc.Cells(j, 1).Value = j - 2

Case "站街"

j = zj.[A65535].End(xlUp).Row + 1

' hm.Range(hm.Cells(i, 1), hm.Cells(i, lastColumn)).Copy zj.Cells(j, 1)

hm.Rows(i).Copy zj.Rows(j)

zj.Cells(j, 1).Value = j - 2

Case "流长"

j = lc.[A65535].End(xlUp).Row + 1

' hm.Range(hm.Cells(i, 1), hm.Cells(i, lastColumn)).Copy lc.Cells(j, 1)

hm.Rows(i).Copy lc.Rows(j)

lc.Cells(j, 1).Value = j - 2

Case "王庄"

j = wz.[A65535].End(xlUp).Row + 1

' hm.Range(hm.Cells(i, 1), hm.Cells(i, lastColumn)).Copy wz.Cells(j, 1)

hm.Rows(i).Copy wz.Rows(j)

wz.Cells(j, 1).Value = j - 2

Case "青龙"

j = ql.[A65535].End(xlUp).Row + 1

' hm.Range(hm.Cells(i, 1), hm.Cells(i, lastColumn)).Copy ql.Cells(j, 1)

hm.Rows(i).Copy ql.Rows(j)

ql.Cells(j, 1).Value = j - 2

Case "红枫"

j = hf.[A65535].End(xlUp).Row + 1

' hm.Range(hm.Cells(i, 1), hm.Cells(i, lastColumn)).Copy hf.Cells(j, 1)

hm.Rows(i).Copy hf.Rows(j)

hf.Cells(j, 1).Value = j - 2

End Select

End If

Next

End Sub