標籤: VBA

自動彙整資料夾下所有Excel檔案資料到該檔案並增加計算欄位

Sub CombineExcelFilesFirstSheetExceptFirstRow()
Dim Path As String, Filename As String, Sheet As Worksheet, LastRow As Long, i As Integer, cFilename As String
Dim wb As Workbook, DestSheet As Worksheet, LastDestRow As Long, Owb As Workbook
ClearAllRowsExceptFirst
Application.ScreenUpdating = False
Application.CutCopyMode = False
‘ Get the path of the folder that contains the current workbook
Path = ThisWorkbook.Path & “\”
Set Owb = ActiveWorkbook
‘ Loop through all the Excel files in the folder
Filename = Dir(Path & “.xlsx“)
cFilename = ThisWorkbook.Name
Do While Filename <> “”
‘ Exclude the current workbook from the merge
If Filename <> cFilename Then
‘ Open each Excel file in the folder
Set wb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
‘ Copy the data from the first worksheet of the Excel file, excluding the first row
With wb.Sheets(1)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If LastRow > 1 Then
.Range(“A2”).Resize(LastRow – 1, .UsedRange.Columns.Count).Copy Destination:=Owb.ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Offset(1, 0)
End If
End With
‘ Close the Excel file
wb.Close
End If
‘ Move to the next Excel file in the folder
Filename = Dir()
Loop
‘ Adjust the column widths in the current worksheet
‘For i = 1 To ActiveSheet.Columns.Count
‘ ActiveSheet.Columns(i).AutoFit
‘Next i
AddConditionalFormulaToColumn
Application.ScreenUpdating = True
Application.CutCopyMode = True
End Sub

Sub ClearAllRowsExceptFirst()
With ActiveSheet
.Range(“A2:” & .Cells(.Rows.Count, .Columns.Count).Address).ClearContents
End With
End Sub

Sub AddConditionalFormulaToColumn()
Dim lastRow As Long
lastRow = Cells(Rows.Count, “A”).End(xlUp).Row ‘ Assumes data is in column A
Range(“U2:U” & lastRow).Formula = “=ROUND(IF(L2=””三聯式””,R2+S2,R2)*IF(B2=””STW0192″”,0.5,1),0)”
‘ Alternatively, you can use the FormulaR1C1 property to add the formula
‘ in R1C1 notation:
‘Range(“C2:C” & lastRow).FormulaR1C1 = “=IF(RC[-1]=””STW0192″”,0.5,1)”
End Sub

Excel Button Click with ERROR handler

Sub 按鈕1_Click()
‘On Error Resume Next
On Error GoTo MyErrorHandler:
s_line = Cells(1, 8)
e_line = Cells(1, 9)
If Not IsNumeric(s_line) Then
MsgBox (“請輸入數字”)
End
End If
If Not IsNumeric(e_line) Then
MsgBox (“請輸入數字”)
End
End If
If s_line > e_line Then
MsgBox (“請輸入正確起訖”)
End
End If
If e_line – s_line > 4 Then
MsgBox (“最多輸入5筆資料”)
End
End If
Range(“C5:F9”).Value = “”

For i = 1 To e_line - s_line + 1
    'Cells(4 + i, 3).Value = Worksheets("shipment").Cells(s_line + i - 1, 14).Value
    Cells(4 + i, 3).Value = Application.WorksheetFunction.VLookup(Worksheets("shipment").Cells(s_line + i - 1, 6).Value, Worksheets("item_ref").Range("A:E"), 2, False)
    Cells(4 + i, 5).Value = Worksheets("shipment").Cells(s_line + i - 1, 7).Value
    Cells(4 + i, 6).Value = Worksheets("shipment").Cells(s_line + i - 1, 9).Value
Next i

Exit Sub

MyErrorHandler:
If Err.Number = 1004 Then
MsgBox “第” & CStr(s_line + i – 1) & “行無參照品名”
Resume Next
ElseIf Err.Number = 13 Then
MsgBox “You have entered an invalid value.”
End If

End Sub

自訂 IsInt函數 檢查是否是整數

Function IsInt(aValue as Variant) As Boolean
    On Error Resume Next
    IsInt = (CInt(aValue) = aValue)
    On Error Goto 0
End Function