- ©«¤l
- 63
- ¥DÃD
- 32
- ºëµØ
- 0
- ¿n¤À
- 125
- ÂI¦W
- 0
- §@·~¨t²Î
- WIn10
- ³nÅ骩¥»
- OFFICE2013
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2018-7-19
- ³Ì«áµn¿ý
- 2022-8-11
|
[µo°Ý] Ãö©óVBA ¥Î©óVB«ö¶s°ÝÃD¡C
·Q½Ð±Ð¤j®a¦p¦ó±NVBAªº·½½X·h¶iVBªº«ö¶s¤º,·í§Ú«ö¤UVBªº«ö¶s«á¥L·|°õ¦æ¬ÛÃöªº
°Ê§@,·Q½Ð±Ð¥H¤U¨â¤j¬qVBA ·½½XÀ³¦p¦óקï¦ÜVB¤º,·PÁ¡C
Sub Job_No()
Dim a As Integer
Dim b As Integer
Dim rowNum As Integer
Dim Book As Integer
Dim BookName As String
BookNum = Workbooks.Count
'MsgBox BookNum
For a = 1 To BookNum
BookName = Workbooks(a).Name
Workbooks(BookName).Activate
Range("V:AE").Select
Selection.Delete Shift:=xlToLeft
x = 0
Range("b5").Select
Do
If ActiveCell.Value <> "" Then
x = 0
ActiveCell.Offset(1, 0).Select
Else
Selection.EntireRow.Delete
x = x + 1
End If
Loop Until x > 300
Range("A1").Select
Range("U4") = "#"
Range("U5").Formula = "=LEFT(G1,5)&U4&MID(G1,6,6)"
Range("U5").Select
Selection.Copy
Range("U5").PasteSpecial xlPasteValuesAndNumberFormats
[U5].Copy
With Range("U6:U" & [A65536].End(xlUp).Row)
.PasteSpecial xlPasteFormulas
.Value = .Value
End With
Next a
End Sub
Sub unite_data()
Dim BookNum As Integer, rowNum As Integer, currentRow As Integer
Dim i As Integer
Dim j As Integer
Dim BookName As String
currentRow = 2
BookNum = Workbooks.Count
'MsgBox BookNum
For i = 1 To BookNum
BookName = Workbooks(i).Name
If BookName <> "Data.xlsx" Then
For j = 1 To 1
Workbooks(BookName).Activate
rowNum = Workbooks(BookName).Worksheets("result").UsedRange.Rows.Count
'MsgBox rowNum
If (rowNum - 1 >= 1 And Workbooks(BookName).Worksheets("result").Cells(5, 1).Value <> "") Then
Workbooks(BookName).Worksheets("result").Rows("5:" & rowNum).Select
Selection.Copy
Windows("Data.xlsx").Activate
Rows(currentRow).Select
ActiveSheet.Paste
currentRow = currentRow + (rowNum - 4)
Windows(BookName).Activate
End If
Next j
End If
Next i
Windows("Data.xlsx").Activate
Range("V2:V500").Value = "1"
Range("W2").Formula = "=P2"
[W2].Copy
With Range("W3:W" & [A65536].End(xlUp).Row).PasteSpecial
Range("X2").Formula = "=P2"
[X2].Copy
With Range("X3:X" & [A65536].End(xlUp).Row).PasteSpecial
Range("Y2").Formula = "=U2"
[Y2].Copy
With Range("Y3:Y" & [A65536].End(xlUp).Row).PasteSpecial
Range("V2:V500").Select
With Selection.font
.Size = 15
Range("X2:X500").Select
With Selection.font
.Size = 15
Range("V2:V500").Select
With Selection.font
.Size = 15
Range("W2:W500").Select
With Selection.font
.Size = 15
Range("Y2:Y500").Select
With Selection.font
.Size = 15
End With
End With
End With
End With
End With
End With
End With
End With
End Sub |
|