bladeyang – 第 2 頁 – IT工作備忘錄

Excel VBA用SQL語法找出生產報工資料員工每日最早一筆報工開始與最晚一筆報工結束做工時統計，資料來源為自己的寫法.

chatgpt提醒Make sure to add a reference to the “Microsoft ActiveX Data Objects” library in your VBA project by going to “Tools” > “References” and checking the appropriate version (e.g., “Microsoft ActiveX Data Objects x.x Library”). 實測office2010 選用 2.8 library是可行。

Sub GetGroupedData()
    ' Define variables
    Dim wsResult As Worksheet
    Dim wsSource As Worksheet
    Dim rngSource As Range
    Dim rngResult As Range
    Dim strSQL As String
    Dim connString As String
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim rowIndex As Long
    Dim colIndex As Long
    Dim strSourceRng As String
    ' Set the source worksheet
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    
     Dim lastRow As Long
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    
    strSourceRng = Trim("[Sheet1$A1:F" + Trim(Str(lastRow)) + "]")
        
    ' Check if the result sheet already exists
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("Result")
    On Error GoTo 0
    
    ' If the result sheet exists, clear its contents
    If Not wsResult Is Nothing Then
        Application.DisplayAlerts = False
        wsResult.Cells.Clear
        Application.DisplayAlerts = True
    Else
        ' If the result sheet doesn't exist, create it
        Set wsResult = ThisWorkbook.Worksheets.Add
        wsResult.Name = "Result"
    End If
    
    ' Define the range where the result will be displayed
    Set rngResult = wsResult.Range("A1")
    
    ' Connection string (Excel version-dependent)
    connString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";" & _
                 "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    
    ' SQL query to retrieve the grouped data
    'strSQL = "SELECT col1, col2, col3, col4, MIN(col5) AS MinValue, MAX(col6) AS MaxValue FROM [Sheet1$A1:N274] " & _
             "GROUP BY col1, col2, col3, col4"
    
    strSQL = "SELECT col1, col2, col3, col4, MIN(col5) AS MinValue, MAX(col6) AS MaxValue FROM " & strSourceRng & _
             "GROUP BY col1, col2, col3, col4"
    'wsSource.Range("N3").Value = strSQL
    
    ' Create a connection object
    Set cn = New ADODB.Connection
    
    ' Open the connection
    cn.Open connString
    
    ' Create a recordset object
    Set rs = New ADODB.Recordset
    
    ' Execute the query and populate the recordset
    rs.Open strSQL, cn
    
    ' Write the column headers to the result range
    For colIndex = 1 To rs.Fields.Count
        rngResult.Offset(0, colIndex - 1).Value = rs.Fields(colIndex - 1).Name
    Next colIndex
        rngResult.Offset(0, colIndex - 1).Value = "時數(HR)"
    ' Write the data to the result range
    rowIndex = 1
    Do Until rs.EOF
        For colIndex = 1 To rs.Fields.Count
            rngResult.Offset(rowIndex, colIndex - 1).Value = rs.Fields(colIndex - 1).Value
        Next colIndex
               ' Convert col5 and col6 to DateTime values
        Dim dt1 As Date
        Dim dt2 As Date
        dt1 = CDate(rs.Fields("MinValue").Value)
        dt2 = CDate(rs.Fields("MaxValue").Value)
        
        ' Calculate the difference and add as col7
        Dim diff As Double
        diff = dt2 - dt1
        rngResult.Offset(rowIndex, rs.Fields.Count).Value = Round(diff * 24, 2)
        
        rs.MoveNext
        rowIndex = rowIndex + 1
    Loop
    
    ' Clean up
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
    
    ' Format the result range as desired
    
    ' Optional: Autofit columns in the result range
    wsResult.Columns.AutoFit
End Sub

其中組合SQL語法from 片段時原本程式碼為
 ' Set the name of the sheet containing the data
    sheetName = "Sheet1"
    
    ' Set the range of data in Sheet1
    Set rngData = ThisWorkbook.Worksheets(sheetName).UsedRange
  
    ' SQL query to retrieve data from Sheet1
    strSQL = "SELECT * FROM [" & sheetName & "$" & rngData.Address & "]"

會有錯誤才改成自行抓取最後一筆，手動組成範圍。

原本不使用VBA與SQL語法，單純用excel Function來做
1.手動找出distinct的 上班日、員工代號、姓名、報工別
2.將上下工時間由字串改成日期時間 =DATEVALUE(上工時間) + TIMEVALUE(上工時間)，這樣才能做運算，算出時數。
3.=MAX(IF((A:A=L2)*(B:B=M2)*(D:D=O2),I:I)) 找出MAX值
  =MIN(IF((A:A=L2)*(B:B=M2)*(D:D=O2),H:H)) 找出MIN值
  其中L、M、O欄位第1.步驟抓出之distinct值 A、B、D為原始資料
4.Instead of pressing Enter, use Ctrl+Shift+Enter to enter the formula as an array formula. This will enclose the formula in curly braces {} and calculate the distinct values based on the three columns
5.差異為=(MAX-MIN)*24

WIN11 + EpsonLQ-680連線問題排除

舊配置 AMD文書機 win10 home +USB延長線+USB 轉LPT port+LQ-680可正常列印

新配置主機換成DELL i5-12400 + win11 home 一樣連線方式，卻發生列印幾張後即中斷、列印任務卡住等異常。

問題排除一：假設-USB延長線生鏽或接觸不良導致。實作-改用USB Printer server連線方式，win11 home+網路+USB Printer server+USB 轉LPT port+LQ-680，狀況一樣，連續列印會中斷。

問題排除二：假設-USB 轉LPT port轉接線異常。實作-改用LPT Printer server 連線方式，win11 home+網路+LPT Printer server+LQ-680，狀況一樣。

問題排除三：假設-軟體或設定導致。實作-於印表機內容連接埠設定由LPR改成RAW，問題終於排除。觀測印表機工作佇列，RAW會一下子吃掉所有工作，LPR則會一個一個慢慢執行。運作模式不同而導致結果不同。

狀況二：隔週使用者反映印表機又無法使用啦！！！

問題排除四：假設-於排除三運作模式已確認可行，應為其他硬體問體導致。實作-ping printer server發現無法ping通，重啟printer server也無法ping通，換一條網路線就可以通了，此時使用者發現原來網路線被折彎，導致有個角度才會通。

總結：由於此為外點之設備，無法直接實機檢測與排除，遠端遙控使用者操作增加異常排除難度與時程拖長，期間使用者抱怨無法使用，只有耐心溝通，按照假設一步步實作，終於解決。觀察點一：原本舊機+win10直連方式換成新機+win11卻無法正常運作，還是不知原因，因為直連不須也無法設定連接埠。觀察點二：連接埠LPR與RAW運作模式之差異，導致實際使用結果不同，這兩種模式之差異與適用時機為何？

EXCEL分欄列印–一頁印原兩頁資料

Step1.首先選取Excel中要列印的部分，並按下功能表的【編輯】→【複製】。
Step2.開啟Word程式，打開一個新文件後，按下功能表的【編輯】→【貼上】。
Step3.貼上從Excel複製過來的欄位內容後，繼續在Word裡點選功能表的【格式】→【欄】。
Step4.在「欄」對話盒裡，選取要分割的欄位數量後，按下〔確定〕。
Step5.接著選取第一列，並按下功能表的【表格】→【跨頁標題重複】。
Step6.最後可以看到Word中的每一欄表頭，都會出現標題列，這樣就能把Excel裡的資料做分欄列印了。

寄信到gmail被退信，DNS新增SPF紀錄可解決

錯誤訊息

Remote server replied: 550-5.7.26 This mail is unauthenticated, which poses a security risk to the

550-5.7.26 sender and Gmail users, and has been blocked. The sender must

550-5.7.26 authenticate with at least one of SPF or DKIM. For this message, 550-5.7.26 DKIM checks did not pass and SPF check for

今天終於拿到DNS管理帳密，登入twnic找到DNS管理，新增一筆 TXT紀錄
Value: v=spf1 ip4:192.168.x.x 如下圖(此ip為對外發信實體IP)，這樣就解決啦。

參考 https://openfind.zendesk.com/hc/zh-tw/articles/5336499446159-SPF-%E8%A8%AD%E5%AE%9A%E6%96%87%E4%BB%B6

https://support.google.com/a/answer/10685031?sjid=15193580675983634622-AP

測試使用chatgpt產生語法針對excel檔案按照某欄資料分組，各組資料複製到各自新的頁面

第一次指令 design VBA code to move data from Sheet1 to newly inserted sheets based on certain group

Sub MoveData()

    Dim lastRow As Long
    Dim i As Long
    Dim groupName As String
    Dim ws As Worksheet
    Dim newWs As Worksheet
    
    'Get last row of data in Sheet1
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    'Loop through each row of data in Sheet1
    For i = 2 To lastRow 'Assuming data starts in row 2
        
        'Get the group name from column A
        groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
        
        'Check if there is already a worksheet with the group name
        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(groupName)
        On Error GoTo 0
        
        'If there is no worksheet with the group name, insert a new worksheet
        If ws Is Nothing Then
            Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            newWs.Name = groupName
        Else
            Set newWs = ws
        End If
        
        'Copy the data from Sheet1 to the new worksheet
        ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=newWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        
    Next i
    
End Sub

第二次指令 please use 4th column as group and copy first row as header to every new sheet

Sub MoveData()

    Dim lastRow As Long
    Dim i As Long
    Dim groupName As String
    Dim ws As Worksheet
    Dim newWs As Worksheet
    
    'Get last row of data in Sheet1
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    'Copy header row to every new sheet
    ThisWorkbook.Worksheets("Sheet1").Rows(1).Copy
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Sheet1" Then
            ws.Rows(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next ws
    
    'Loop through each row of data in Sheet1
    For i = 2 To lastRow 'Assuming data starts in row 2
        
        'Get the group name from column D
        groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
        
        'Check if there is already a worksheet with the group name
        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(groupName)
        On Error GoTo 0
        
        'If there is no worksheet with the group name, insert a new worksheet
        If ws Is Nothing Then
            Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            newWs.Name = groupName
        Else
            Set newWs = ws
        End If
        
        'Copy the data from Sheet1 to the new worksheet
        ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=newWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        
    Next i
    
End Sub

第三次指令 please change your procedure,first get distinct group from column d ,second create sheets for each group then copy header from sheet1 finally move data. 1.先分組 2.建立所有頁面 3.複製標題 4.複製相對資料

Sub MoveData()

    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim groupName As String
    Dim groupNames() As String
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim found As Boolean
    
    'Get last row of data in Sheet1
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    'Get distinct group names from column D
    ReDim groupNames(0 To 0)
    groupNames(0) = ThisWorkbook.Worksheets("Sheet1").Cells(2, 4).Value 'Assuming data starts in row 2
    For i = 2 To lastRow
        groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
        found = False
        For j = 0 To UBound(groupNames)
            If groupName = groupNames(j) Then
                found = True
                Exit For
            End If
        Next j
        If Not found Then
            ReDim Preserve groupNames(0 To UBound(groupNames) + 1)
            groupNames(UBound(groupNames)) = groupName
        End If
    Next i
    
    'Create new worksheet for each group name
    For i = 0 To UBound(groupNames)
        Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        newWs.Name = groupNames(i)
        ThisWorkbook.Worksheets("Sheet1").Rows(1).Copy
        newWs.Rows(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
    
    'Loop through each row of data in Sheet1 and move to appropriate worksheet
    For i = 2 To lastRow 'Assuming data starts in row 2
        groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
        Set ws = ThisWorkbook.Worksheets(groupName)
        ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next i
    
End Sub

before creating a new worksheet check if alread exists

before insert header row clear datas in that sheet

Sub MoveData()

    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim groupName As String
    Dim groupNames() As String
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim found As Boolean
    
    'Get last row of data in Sheet1
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    'Get distinct group names from column D
    ReDim groupNames(0 To 0)
    groupNames(0) = ThisWorkbook.Worksheets("Sheet1").Cells(2, 4).Value 'Assuming data starts in row 2
    For i = 2 To lastRow
        groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
        found = False
        For j = 0 To UBound(groupNames)
            If groupName = groupNames(j) Then
                found = True
                Exit For
            End If
        Next j
        If Not found Then
            ReDim Preserve groupNames(0 To UBound(groupNames) + 1)
            groupNames(UBound(groupNames)) = groupName
        End If
    Next i
    
    'Create new worksheet for each group name if it doesn't already exist
    For i = 0 To UBound(groupNames)
        found = False
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name = groupNames(i) Then
                found = True
                Set newWs = ws
                Exit For
            End If
        Next ws
        If Not found Then
            Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            newWs.Name = groupNames(i)
            newWs.Cells.ClearContents 'Clear any existing data in the new worksheet
            ThisWorkbook.Worksheets("Sheet1").Rows(1).Copy
            newWs.Rows(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next i
    
    'Loop through each row of data in Sheet1 and move to appropriate worksheet
    For i = 2 To lastRow 'Assuming data starts in row 2
        groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
        Set ws = ThisWorkbook.Worksheets(groupName)
        ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next i
    
End Sub

prompt to get the group column number before starting

Sub MoveData()

    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim groupName As String
    Dim groupNames() As String
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim found As Boolean
    Dim groupCol As Long
    
    'Prompt user for group column number
    groupCol = Application.InputBox("Enter the column number for the group:", Type:=1)
    
    'Get last row of data in Sheet1
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    'Get distinct group names from specified column
    ReDim groupNames(0 To 0)
    groupNames(0) = ThisWorkbook.Worksheets("Sheet1").Cells(2, groupCol).Value 'Assuming data starts in row 2
    For i = 2 To lastRow
        groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, groupCol).Value
        found = False
        For j = 0 To UBound(groupNames)
            If groupName = groupNames(j) Then
                found = True
                Exit For
            End If
        Next j
        If Not found Then
            ReDim Preserve groupNames(0 To UBound(groupNames) + 1)
            groupNames(UBound(groupNames)) = groupName
        End If
    Next i
    
    'Create new worksheet for each group name if it doesn't already exist
    For i = 0 To UBound(groupNames)
        found = False
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name = groupNames(i) Then
                found = True
                Set newWs = ws
                Exit For
            End If
        Next ws
        If Not found Then
            Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            newWs.Name = groupNames(i)
            newWs.Cells.ClearContents 'Clear any existing data in the new worksheet
            ThisWorkbook.Worksheets("Sheet1").Rows(1).Copy
            newWs.Rows(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next i
    
    'Loop through each row of data in Sheet1 and move to appropriate worksheet
    For i = 2 To lastRow 'Assuming data starts in row 2
        groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, groupCol).Value
        Set ws = ThisWorkbook.Worksheets(groupName)
        ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next i
    
End Sub

最終結果與預期需求相符，感想：優點過程中打錯字或是文法不對，chatGPT還是能夠大致了解，感覺語文理解力很強，程式範例庫眾多，基礎語法與程式架構標準化。缺點是流程運行前後邏輯較差，透過子模組切分與流程先後串聯提示可改善。

bing + Chatgpt 4.0 不須指示先按group建立sheet，coding 能力似乎又強化

Sub MoveData()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim groupCol As Long
    Dim sheetName As String
    
    'Delete all sheets except Sheet1
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "Sheet1" Then
            ws.Delete
        End If
    Next ws
    Application.DisplayAlerts = True
    
    'Move data from Sheet1 to newly inserted sheets based on group
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    groupCol = Application.InputBox("Enter the column number of the group:", "Group Column", Type:=1)
    
    For i = 2 To lastRow
        sheetName = ws.Cells(i, groupCol).Value
        If Not SheetExists(sheetName) Then
            ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = sheetName
            ws.Rows(1).Copy Destination:=ThisWorkbook.Sheets(sheetName).Cells(1, 1)
        End If
        ws.Rows(i).Copy Destination:=ThisWorkbook.Sheets(sheetName).Cells(ThisWorkbook.Sheets(sheetName).Cells(ThisWorkbook.Sheets(sheetName).Rows.Count, 1).End(xlUp).Row + 1, 1)
    Next i
End Sub

Function SheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0
    SheetExists = Not ws Is Nothing
End Function

move_data 下載

自動彙整資料夾下所有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公式加上大括號{}的用法

當一個公式中，含有返回一組數的表達式時，需使用數組進行運算。在公式輸入完成之後，按ctrl+shift+enter三鍵，會自動加上大括號{}{=SUM(IF(MOD(COLUMN($D4:$LB4),10)=4,$D4:$LB4,0))} 指加總範圍內每10欄的第四欄。

參考 https://www.dotblogs.com.tw/areswang/2020/10/26/Dynamic_array_formulas_2

CROSS join 常數table產生多筆資料如月份

select
m.site,
m.cal_year,
m.currency_id,
m.main_account,
m.sub_account,
m.project,
m.dept_no,
X.a,
0,
0,
0,
0,
‘XYZ’,
‘2023-02-21 12:00:00’
from
sybase64.erpdb.dbo.acc_balm m
left outer join sybase64.erpdb.dbo.acc_bald d on m.site = d.site
and m.cal_year = d.cal_year
and m.main_account = d.main_account
and m.currency_id = d.currency_id
and m.sub_account = d.sub_account
and m.project = d.project
and m.dept_no = d.dept_no cross
join (
VALUES
(’01’),
(’02’),
(’03’),
(’04’),
(’05’),
(’06’),
(’07’),
(’08’),
(’09’),
(’10’),
(’11’),
(’12’),
(’13’)
) AS X(a)
where
m.site = ‘CF’
and m.cal_year = ‘2023’
and m.main_account = ‘1122’
and d.site is null;

Excel 新增自訂 function 數字轉大寫中文

Function Num2Str(Str As String) As String
For i = 1 To Len(Str)
a = Mid(Str, i, 1)
Select Case True
Case a = 0
aa = aa & “　零”
Case a = 1
aa = aa & “　壹”
Case a = 2
aa = aa & “　貳”
Case a = 3
aa = aa & “　參”
Case a = 4
aa = aa & “　肆”
Case a = 5
aa = aa & “　伍”
Case a = 6
aa = aa & “　陸”
Case a = 7
aa = aa & “　柒”
Case a = 8
aa = aa & “　捌”
Case a = 9
aa = aa & “　玖”
Case Else
aa = aa & a
End Select
Next i
aa = Right(“零　零　零　零　零　零　零　零　零” & aa, 18)
bb = Left(aa, 6) & ” ” & Mid(aa, 7, 2) & ” ” & Mid(aa, 9, 2) & ” ” & Mid(aa, 11, 2) & Right(aa, 6)
Num2Str = bb
End Function

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