顯示具有 Office軟體相關 標籤的文章。 顯示所有文章
顯示具有 Office軟體相關 標籤的文章。 顯示所有文章

2024年4月22日 星期一

PivotTable樞鈕分析表,搭配Formula公式運用,詳列出⌈廠牌型號⌋,在各個" 部門別"之擁有 台數 報表產製

EXCEL資料表,分別有 財產設備大分類、廠牌型號、部門別、數量 等4欄位,
        A                                  B                       C                 D
1    財產設備大分類        廠牌型號              部門別           數量
2    個人電腦           HP Pro SFF 400 G9    人事               2
3    個人電腦           HP Pro SFF 400 G9     財務              2
4    個人電腦           HP Pro SFF 400 G9    行政               2
5    個人電腦           HP Pro SFF 400 G9     銷售              2
6    個人電腦           ASUS S500TE             研發               1
7    個人電腦           HP Pro SFF 400 G9     研發               1
8    個人電腦           HP Pro SFF 400 G9     資訊               2


公司部門,有人事、財務、行政、銷售、研發、資訊等6部門別

有1份報表,需臚列出  財產設備大分類,其各⌈廠牌型號⌋,分配到公司,各個部門之台數(如下方產出的結果)

,####################################################################################
以下是個人作法,先用「樞紐分析表」,將EXCEL資料 預做梳理,
 

在以下區域之間拖曳欄位:

💛篩選  拖曳  財產設備大分類、    (因為有數個「財產設備大分類」項目,如:個人電腦、筆電)
💜欄    拖曳  部門別、                    (方便掌握 各部門別,可逐欄一一列出)
💜列    拖曳   廠牌型號、              (各廠牌型號,以此例「個人電腦」大分類,呈現會有2列,

                                                   分別  為HP Pro SFF 400 G9 及 ASUS S500TE    等2類桌機
💜值    拖曳    數量                        (可幫忙預先加總,列出各部門別,各廠牌型號 電腦之台數)
'=====================================================================
💙'T1欄及O1欄,公式手動設定好
💛B1欄,為PivotTable樞鈕分析表之 大分類「財產設備大分類」,個人電腦、筆電等可供下拉(此欄位值,即為上面  篩選  拖曳,自動產生),只要下拉變動不同之大分類,樞鈕分析表之欄及列 資料,也會隨之變動。

💙T1欄(=COUNTA(4:4)),為PivotTable樞鈕分析表之總欄數   ,因為第4列為PivoteTable部門別,逐欄一一列出,此T1欄的值,為手動填入COUNTA公式
此公式之目的主要為讓後續VBA程式,清楚掌握「個人電腦」大分類中,共有多少 部門別?在PivotTable中,如該部門別沒有分配到大分類資源者,將不會列出部門別,故此欄會隨著大分類之不同,而做變動。


💙O1欄(=COUNTA(A:A)+1),為PivotTable樞鈕分析表之總列數  ,因為A欄為PivoteTable廠牌型號,逐列一一呈現,此O1欄的值,為手動填入COUNTA公式
此公式之目的主要為讓後續VBA程式,清楚掌握「個人電腦」大分類中,共有多少項?廠牌型號,此欄會隨著大分類之不同,而做變動(total_Rows)。

'####################################################################################

Sub ApplyFormula()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim total_Rows As Long
    Dim formulaRange As Range
    Dim i As Long
    
    '來源4個欄位,經過「樞紐分析表」,將資料預做梳理後,工作表名稱指定為Pivot_1
    Set ws = ThisWorkbook.Sheets("Pivot_1")
    
    '因「樞紐分析表」精靈產出後,上半段前3列已固定做標題列用途,故要扣除3後,每次下拉💛B1「財產設備大分類」後,才是實際⌈廠牌型號⌋之資料筆數。
    total_Rows = ws.Range("O1").Value - 3
    
    Sheets("Pivot_1").Select
    Columns("P:P").Select        '清空P欄,因為在下拉⌈財產設備大分類⌋,會貼不同的Formula
    Selection.ClearContents
     
    ' 預訂放置公式的起始處,預訂每次均由P5欄開始放置
    Set formulaRange = ws.Range("P5")
    
    
    ' 各列⌈廠牌型號⌋,詳列出 各個 "部門別"擁有之台數,逐一詳列出來
    For i = 1 To total_Rows    ' 第一列開始,直到最後一列
        '搭配Range & Formula ,方便每次於💛B1下拉「財產設備大分類,每列最後貼上公式
        formulaRange.Offset(i - 1, 0).Formula = "=IF($B" & i + 4 & ">0, $B$4&$B" & i + 4 & "&""台, "", """")" & _
                                                "&IF($C" & i + 4 & ">0, $C$4&$C" & i + 4 & "&""台, "", """")" & _
                                                "&IF($D" & i + 4 & ">0, $D$4&$D" & i + 4 & "&""台, "", """")" & _
                                                "&IF($E" & i + 4 & ">0, $E$4&$E" & i + 4 & "&""台, "", """")" & _
                                                "&IF($F" & i + 4 & ">0, $F$4&$F" & i + 4 & "&""台, "", """")" & _
                                                "&IF($G" & i + 4 & ">0, $G$4&$G" & i + 4 & "&""台, "", """")" & _
                                                "&IF($H" & i + 4 & ">0, $H$4&$H" & i + 4 & "&""台, "", """")"
                                '最後一列,為該大分類,各部門別彙整後之小計台數 (因為PivotTable樞鈕分析表已預先產製好)  ;最前方IF判斷式>0,即 台數>0,則顯示 部門別及台數。                                                                                                             
    Next i      
End Sub

 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

產出的結果 ( 💛B1欄「財產設備大分類」,下拉選擇⌈個人電腦⌋)

列標籤                 人事    財務   行政   銷售   研發    資訊

HP Pro SFF 400 G9     2         2         2        2         1          2  ,人事2台,財務2台....研發1台....(略)

ASUS S500TE                                           1               ,研發1台

 總計                     2         2         2        2         2          2  ,人事2台....................研發2台,資訊2台


'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

PROMPT提示詞下法如下: (可將下面提示詞,貼至AI神器去詢問,取得VBA程式碼參考資訊)
處理前之樞鈕分析表,計有4欄位

篩選  拖曳  財產設備大分類、
欄    拖曳  部門別、
列    拖曳   廠牌型號、
值    拖曳    數量


經過「樞紐分析表」處理後,工作表名稱指定為Pivot_1
B1欄,為樞鈕分析表之篩選  財產設備大分類

excel表中,第4列為標題列,分別為 A4 廠牌型號、B4 人事、C4 財務、D4 行政、E4 銷售、F4 研發、G4 資訊H4 ,

T1欄,公式已設好  =COUNTA(4:4),為樞鈕分析表之總欄數
O1欄,公式已設好  =COUNTA(A:A)+1,為樞鈕分析表之總列數

下面公式為全數設備型號,我已將每列總數 放於 P5開始放置公式, 因為台數為0 ,就無需放入,請參考下面公式,寫VBA程式
    
    total_Rows = ws.Range("O1").Value - 3
    
    Sheets("Pivot_1").Select
    Columns("P:P").Select       
    Selection.ClearContents
     
    Set formulaRange = ws.Range("P5")
    
    For i = 1 To total_Rows    ' 第一列開始,直到最後一列
        '搭配Range & Formula ,方便每次於💛B1下拉「財產設備大分類,每列最後貼上公式
        formulaRange.Offset(i - 1, 0).Formula = "=IF($B" & i + 4 & ">0, $B$4&$B" & i + 4 & "&""台, "", """")" & _
                                                "&IF($C" & i + 4 & ">0, $C$4&$C" & i + 4 & "&""台, "", """")" & _
                                                "&IF($D" & i + 4 & ">0, $D$4&$D" & i + 4 & "&""台, "", """")" & _
                                                "&IF($E" & i + 4 & ">0, $E$4&$E" & i + 4 & "&""台, "", """")" & _
                                                "&IF($F" & i + 4 & ">0, $F$4&$F" & i + 4 & "&""台, "", """")" & _
                                                "&IF($G" & i + 4 & ">0, $G$4&$G" & i + 4 & "&""台, "", """")" & _
                                                "&IF($H" & i + 4 & ">0, $H$4&$H" & i + 4 & "&""台, "", """")"                                                                                                      
    Next i      



相關參考資訊:

EXCEL VBA 

樞鈕分析表查詢運用


2024年3月12日 星期二

EXCEL表,透過MATCH比對函數,找出郵遞區號

 情境:有數百筆地址,沒有郵遞區號,如何經由EXCEL表透過函數,找出其對應之郵遞區號

工作表1,欄位樣式(待處理查詢郵遞區號之工作表),如下:
新北市板橋區文化路一段
新北市中和區中山路二段
新北市永和區中正路
新北市土城區學府路
新北市三重區正義北路
新北市蘆洲區長安街
新北市五股區新北大道一段
新北市泰山區貴陽街
新北市林口區文化一路
新北市鶯歌區中正一路
高雄市苓雅區三多四路
高雄市前鎮區中華五路
高雄市左營區博愛二路
高雄市楠梓區德民路
高雄市鳳山區光遠路
高雄市鼓山區美術東二路
高雄市岡山區岡山路
高雄市旗津區旗津三路
高雄市鹽埕區大勇路
高雄市仁武區仁武路



工作表2,欄位樣式適要(參照來源之工作表),如下:
220    新北市板橋區
221    新北市汐止區
222    新北市深坑區
223    新北市石碇區
224    新北市瑞芳區
226    新北市平溪區
235    新北市中和區
236    新北市土城區
237    新北市三峽區
238    新北市樹林區
829    高雄市湖內區
830    高雄市鳳山區
831    高雄市大寮區
845    高雄市內門區
846    高雄市杉林區
847    高雄市甲仙區
848    高雄市桃源區
849    高雄市那瑪夏區
851    高雄市茂林區
852    高雄市茄萣區


因為工作表1,地址全數相連,但EXCEL字串比對,需完全一致,因此需將工作表1,先經由EXCEL  資料剖析 |固定寬度(W)| 下一步(N) | 建立分欄線移至區 ,以利新北市OO區 獨立成1欄位



中華郵政郵遞區號,先下載後,並放置於EXCEL 工作表2
https://www.post.gov.tw/post/internet/Download/all_list.jsp?ID=2201#dl_link_2735



PROMPT提示詞下法(如藍色部分)

在EXCEL工作表1,A欄為空白欄,做為郵遞區號查詢後,放置處
在EXCEL工作表2,A欄為郵遞區號,B欄為地址含區
請使用OFFSET及MATCH函數,幫忙將工作表1之B1~B20地址,找出其郵遞區號



=IFERROR(OFFSET(工作表2!$A$1, MATCH(B1, 工作表2!$B$1:$B$20, 0) - 1, 0), "未找到該住址之郵遞區號")

2024年3月5日 星期二

請AI幫忙寫EXCEL VBA,並用內建繪圖元件幫忙畫 迴歸直線圖 ,及其找出其線性函數式

 情境:因EXCEL圖表製圖不熟悉,可透過AI工具,協助幫忙產出EXCEL VBA進行繪製

迴歸直線圖 ,及其找出其線性函數式。y = 4.341x + 43.017

 

EXCEL表格,如下:    

      A               B                  C
1 年度        行銷費X        銷售額Y
2  109               2                50
3  110               3                66
4  111               6                54
5  112               9                88
6  113               12              96

💚EXCEL預先準備環境
檔案 | 選項 |增益集 | 設定
增益集| 勾選 分析工具箱 | 確定


💚EXCEL分析操作設定, 資料 | 資料分析 | 迴歸 |確定
輸入Y範圍(Y): 工作表1!$C$2:$C$6
輸入X範圍(X): 工作表1!$B$2:$B$6
 

EXCEL迴歸分析產出結果,如下:
摘要輸出                               
                               
迴歸統計                               
R 的倍數    0.883984674                           
R 平方    0.781428904                           
調整的 R 平方    0.708571872                           
標準誤    11.02650511                           
觀察值個數    5                           
                               
ANOVA                               
    自由度    SS    MS    F    顯著值           
迴歸    1    1304.048555    1304.048555    10.72551108    0.046601631           
殘差    3    364.7514451    121.583815                   
總和    4    1668.8                       
                               
    係數    標準誤    t 統計    P-值    下限 95%    上限 95%    下限 95.0%    上限 95.0%
截距   
43.01734104    9.812397095    4.38397882    0.021976561    11.78991416    74.24476792    11.78991416    74.24476792
X 變數 1   
4.341040462    1.325515578    3.274982607    0.046601631    0.12265831    8.559422615    0.12265831    8.559422615



💚AI Prompt提示詞,下法,如藍色部分
有一個EXCEL表,第1列為標題列,A欄為年度,B欄為行銷費X,C欄為銷售額Y,
請用EXCEL VBA,利用其  資料分析  迴歸分析 ,產出迴歸直線圖  ,
X軸為 B欄 ,Y軸為C欄,處理圖表直到最後1筆 ,
請畫出迴歸直線  ,並且將其迴歸直線函數,表示出來

 

AI產出之巨集程式  ,執行CreateRegressionChart巨集,即可產製EXCEL圖表

Sub CreateRegressionChart()

    Dim ws As Worksheet
    Dim LastRow As Long
    Dim DataRange As Range
    Dim XRange As Range
    Dim YRange As Range
    Dim Regression As Object
    Dim RegressionEquation As String
    
    '
指定EXCEL表數據,放置之⌈工作表名稱
    Set ws = ThisWorkbook.Sheets("工作表1") '  
    

    ' 找出資料筆數之總數
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 設定X和Y的範圍
    Set XRange = ws.Range("B2:B" & LastRow)        ' B欄為X軸

    Set YRange = ws.Range("C2:C" & LastRow)       ' C欄為Y
    
    ' 使用LINEST函數,進行迴歸分析
'    RegressionData = WorksheetFunction.LinEst(YRange, XRange, True, True)
    RegressionData = WorksheetFunction.LinEst(YRange, XRange, True, True)

    ' 提取斜率和截距
    Slope = RegressionData(1, 1)
    Intercept = RegressionData(1, 2)
    
    ' 在工作表中,顯示迴歸方程式

    ws.Range("E2").Value = "Regression Equation:"
    ws.Range("F2").Value = "Y = " & Slope & " * X + " & Intercept
    
    ' 繪製線性圖表
    Dim ChartObj As ChartObject
    Dim TrendlineChart As Chart
    
    ' 刪除現有的圖表
    For Each ChartObj In ws.ChartObjects
        ChartObj.Delete
    Next ChartObj
    
    ' 新增趨勢線圖表
    Set ChartObj = ws.ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225)
    Set TrendlineChart = ChartObj.Chart
    
    ' 添加散點圖
    With TrendlineChart
        .ChartType = xlXYScatter
        .SetSourceData Source:=ws.Range("B2:C" & LastRow)
        .HasTitle = True
        .ChartTitle.Text = "Regression Analysis"
        
        ' 添加趨勢線
        With .SeriesCollection.NewSeries
            .XValues = XRange
            .Values = YRange
            .Trendlines.Add(Type:=xlLinear).Select
            .Trendlines(1).DisplayEquation = True
            .Trendlines(1).DisplayRSquared = False
        End With
        
        ' 設定軸標籤
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Text = "X行銷費"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Text = "Y銷售額"
    End With 
End Sub
 

2024年1月18日 星期四

打開PowerPoint簡報檔,出現檔案有問題,按一下 修復

情境:
打開PowerPoint簡報檔時,出現檔案有問題,按一下 修復 ,仍然沒辦法解決問題。
查看其下方修複說明,可能是防毒軟體造成,但用作法二可以開啟,可能是投影片元件設定為鎖定保護所致。

作法一:
開啟Windows 檔案總管  | PPT檔案 |滑鼠右鍵按一下檔案 |選取 [內容]。

在[內容]對話方塊中| 按一下右下方附近的 [解除封鎖] |[套用] |  再按 [確定] ,再次開啟PPT檔即可正常運作。


作法二:嘗試用LibreOffice開啟後,另存成PowerPoint檔案。(此種解法非正統作法,有可能表格會跑掉)


可能原因,是PPT檔案內有些投影片內SHAPE圖形元件,設為受保護,以致於經由網路傳輸給對方時,出現檔案有問題需修復。



相關PPT修複資訊:

無法讀取檔案,或無法開啟簡報(解除封鎖)
PowerPoint 中對損毀的簡報之疑難排解

2023年12月29日 星期五

用PYTHON程式,進行2個EXCEL表,欄位比較

 
比較2個EXCEL表格,檢視上月 及 本月之差異,為加快人工檢視處理,分別各捉取前7筆資料,並對欄位進行比較處理之VBA程式;
同時亦將完整月份(上月/本月)資料載入不同頁籤


Sub CompareExcelFiles()
Application.DisplayAlerts = False
'控制 Excel 應用程式是否顯示警告訊息。
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Integer, j As Integer
    Dim fd As FileDialog
    Dim strFilepPre As String
    Dim strFileCur As String
    
    
    ' '開啟檔案GUI對話窗格,選取上月EXCEL檔,將路徑傳給strFilePre,供開啟比對用
    
     Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "Select a XLS (上月)"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*", 1
        .InitialFileName = "C:\Users\Downloads"
        .AllowMultiSelect = False
        If .Show = True Then
            strFilePre = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    
    Set wb1 = Workbooks.Open(strFilepre)
    Set ws1 = wb1.Worksheets(1)
    
    
    '開啟檔案GUI對話窗格,選取本月EXCEL檔,,將路徑傳給strFileCur,供開啟比對用
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "Select a XLS (本月)"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*", 1
        .InitialFileName = "C:\Users\Downloads"
        .AllowMultiSelect = False
        If .Show = True Then
            strFileCur = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    
    ' 開啟本月.xls  ,路徑請自行修改
    Set wb2 = Workbooks.Open(strFileCur)
    Set ws2 = wb2.Worksheets(1)
    
    ' 建立檢核結果.xls
    Set wb3 = Workbooks.Add
    Set ws3 = wb3.Worksheets(1)
    
    ' 將上月.xls複製到「檢核結果.xls」的"上月"工作表
    On Error Resume Next
    Set ws1Copy = wb3.Worksheets("上月")
    If ws1Copy Is Nothing Then
        Set ws1Copy = wb3.Worksheets.Add(Before:=wb3.Worksheets(1))
        ws1Copy.Name = "上月"
    End If
    ws1.UsedRange.Copy ws1Copy.Range("A1")
    
    ' 將本月.xls複製到「檢核結果.xls」的"本月"工作表
    On Error Resume Next
    Set ws2Copy = wb3.Worksheets("本月")
    If ws2Copy Is Nothing Then
        Set ws2Copy = wb3.Worksheets.Add(Before:=wb3.Worksheets(1))
        ws2Copy.Name = "本月"
    End If
    ws2.UsedRange.Copy ws2Copy.Range("A1")
    
    ' 比較標題欄並將結果寫入「檢核結果.xls」的第1列
    For i = 1 To ws1.UsedRange.Columns.Count
        If ws1.Cells(1, i).Value = ws2.Cells(1, i).Value Then
            ws3.Cells(1, i).Value = "相同"
        Else
            ws3.Cells(1, i).Value = "不同"
        End If
    Next i
    
    ' 保存檢核結果.xls
    wb3.SaveAs "檢核結果.xls"
    
    ' 開啟檢核結果.xls
    Set wb3 = Workbooks.Open("檢核結果.xls")
    Set ws3 = wb3.Worksheets("工作表1")
    
    Windows("檢核結果.xls").Activate
    ws3.Cells.Select
    Selection.ClearContents
    Windows("活頁簿1.xlsm").Activate
    
    
    ' 將上月.xls前6筆(含標題列)複製到檢核結果.xls
    ws3.Cells(2, ws3.UsedRange.Columns.Count + 2) = "上月檢核ˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇ"
    ws1.Range("A1").Resize(5, ws1.UsedRange.Columns.Count).Copy ws3.Cells(3, ws3.UsedRange.Columns.Count + 2)
    ' 將本月.xls前6筆(含標題列)複製到檢核結果.
    ws3.Cells(ws3.UsedRange.Columns.Count + 5, 5) = "本月檢核ˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇˇ"
    ws2.Range("A1").Resize(7, ws2.UsedRange.Columns.Count).Copy ws3.Cells(ws3.UsedRange.Columns.Count + 6, 5)
    
    ' 關閉工作簿
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False
 '  wb3.Close SaveChanges:=True
 
    
    ' 釋放物件
    Set ws1 = Nothing
    Set ws2 = Nothing
    Set ws3 = Nothing
    Set wb1 = Nothing
    Set wb2 = Nothing
 '  Set wb3 = Nothing
    

    Windows("檢核結果.xls").Activate
    Sheets("工作表1").Select
    
 
 Application.DisplayAlerts = True
'控制 Excel 應用程式是否顯示警告訊息。
 
 
End Sub



相關查詢:
INQUIREというアドインを使用して、2つのファイルを比較して違いを表示する (經由 Inquire增益集比對2個EXCEL)

スプレッドシート比較の基本的な作業 (Compare two or more worksheets at the same time)

複数のワークシートを同時に比較する


2023年12月16日 星期六

EXCEL 樞鈕分析表 之應用,將財產細項 (公司 所有資訊設備細項型號產品)歸納,並依單位別的不同,計數其數量

 情境說明:

公司老闆詢問,所有資訊設備細項(即相同型號電腦相關產品,如:ASUS、iPad、印表機等),在每個部門中,各自有多少台裝置在使用,並分別放置於何處?

EXCEL欄位,分別如下:

財產編號    財產分類    財產細項     保管單位    存放地點 ,


1.插入  樞鈕分析表
2.新增 工作表 (EXCEL下方工作表旁 ,+圖示),方便處理顯示 樞鈕分析表
2.點選  右方 樞鈕分析表欄位 財產分類、財產細項、保管單位
3.下方區域之間 拖曳欄位  
        欄,拖曳   保管單位        <--  主要目的,是細分顯示,有多少台使用設備 財產細項
        
        列,拖曳   財產分類、財產細項、存放地點
        
        值,拖曳   財產細項


呈現樣式結果

                          總經理室      人事室      會計室      企劃部         
財產分類
    財產細項
        存放地點
        
電腦
    Apple iPad               1
        總經理辦公桌


2023年12月10日 星期日

延續先前分公司,各自單獨建立分頁  之範例

Excel 分頁過多(分公司多,以致於移動分頁困擾),希望於每個分頁的K1儲存格(即各個分公司 分頁K1儲存格),
再設定一個回總索引頁(即「 各分公司索引清單」)


Perplexity.ai
藉由Perplexity AI(ChatGPT)協助將每個各自獨立分公司分頁中的K1儲存格,建立回總索引頁(即「 各分公司索引清單」)之超連結,方便作業。
PROMPT提示訊息下法:
EXCEL表,有多個分頁,其中 各分公司索引清單,已有指向各分頁之超連結,
請用EXCEL VBA程式,幫忙於 各分頁中 K1儲存格,增設  各分公司索引清單 超連結 ,並將K1更名為  回索引清單。


Sub AddHyperlinkAndRename()
    Dim ws As Worksheet
    Dim wsRef As Worksheet
    Dim LastRow As Long
    Dim LastCol As Long
    Dim i As Long
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "各分公司索引清單" Then
            LastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row
            LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            
            For i = 2 To LastRow
                ws.Range(ws.Rows.Count, i).Value = ""
                ws.Range(ws.Rows.Count, i).EntireRow.Hidden = True
            Next i
            
            ws.Range("K1").Value = "回索引清單"
          
            
              ' 在各分頁的K1儲存格增設超連結
              
              ws.Range("K1").Hyperlinks.Add Anchor:=ws.Range("K1"), Address:="", SubAddress:="'" & "各分公司索引清單" & "'!A1"
                    
            
        End If
    Next ws
End Sub


請按照以下步驟使用此程式:
STEP1:開啟您的Excel檔案。
STEP2:按下Alt + F11進入VBA編輯器。
STEP3:在VBA編輯器中,插入一個新的模組Module。
STEP4:將上述VBA程式碼,複製並貼上到新的模組Module中。
STEP5:在VBA編輯器中,按下F5運行程式。

 

相關應用:

PivotTable樞鈕分析表,搭配Formula公式運用,詳列出   各個" 部門別"之擁有  台數之報表產製

用EXCEL VBA程式,各自單獨建立分公司分頁表,並增設超連結方便索引

因業務需要,有5個分公司(甲~戊)業務要管,想用EXCEL表,

提供給各單位填報回傳資料進行管理,並以分公司名稱 各自單獨建立1個工作表,

同時增設超連結方便索引 。

EXCEL表已先建立好各分公司名稱於A欄位中,如下:
         A
1  分公司名稱  
2  甲分公司
3  乙分公司
4  丙分公司
5  丁分公司
6  戊分公司


藉由AI(ChatGPT)協助建立各自建立分公司獨立分頁,並提供超連結設置,方便檢索


PROMPT提示訊息下法:
EXCEL表中,自A2儲存格起,有多個分公司 放於A欄位中,請提供VBA程式,幫忙建立 分公司分頁 ,並且設置超連結,方便檢索



Sub CreateCompanySheets()
    Dim ws As Worksheet
    Dim company As Range
    
    ' 在第一個工作表中建立一個名為 「 各分公司索引清單」的分頁
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "各分公司索引清單"
    
    ' 在「 各分公司索引清單」分頁中設置標題
    ws.Range("A1").Value = "分公司"
    
    ' 從A2儲存格起,逐一遍歷分公司名稱
    For Each company In ThisWorkbook.Sheets(1).Range("A2:A" & ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
        ' 檢查分公司分頁是否已存在
        If Not SheetExists(company.Value) Then
            ' 如果分公司分頁不存在,則建立一個新的分頁
            ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = company.Value
        End If
        
        ' 在「 各分公司索引清單」分頁中設置超連結
        ws.Hyperlinks.Add Anchor:=ws.Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row + 1), _
                          Address:="", _
                          SubAddress:="'" & company.Value & "'!A1", _
                          TextToDisplay:=company.Value
    Next company
    
    ' 回到  第一個工作表
    ThisWorkbook.Sheets(1).Activate

End Sub

Function SheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    
    SheetExists = False
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = sheetName Then
            SheetExists = True
            Exit Function
        End If
    Next ws
End Function


請按照以下步驟使用此程式:

STEP1:開啟您的Excel檔案。
STEP2:按下Alt + F11進入VBA編輯器。
STEP3:在VBA編輯器中,插入一個新的模組Module。
STEP4:將上述VBA程式碼,複製並貼上到新的模組Module中。
STEP5:在VBA編輯器中,按下F5運行程式。

VBA程式,將會在您的Excel檔案中建立一個名為「 各分公司索引清單」的分頁,並在該分頁中列出 所有分公司的超連結。點擊超連結即可跳轉到相對應的分公司 分頁 。

2023年12月9日 星期六

將多個不同分公司EXCEL成本花費表,合併成單一EXCEL總表

總公司有許多分公司,甲、乙、丙分公司,各自維護獨立 成本花費EXCEL報表,每月需匯整成單一EXCEL總表中


甲、乙、丙分公司各自有成本花費EXCEL報表,且它們成本花費報表  ,其首欄位都有相同花費成本細項,但欄位放置位置都不一定相同


匯整甲、乙、丙分公司,成本花費EXCEL報表欄位全數欄位有    地點,姓名,加班費,差旅費,雜費,租賃費,其它 等欄位


所以,總公司,每月均需匯整甲、乙、丙分公司之成本花費EXCEL報表,合併成單一 EXCEL成本花費總表

To merge the three Excel files into a single file named "MergeOK.xlsx" in the "總公司" folder which located in the D drive,

藉由AI(ChatGPT)寫合併EXCEL
PROMPT提示訊息下法:
在D槽中有 總公司 資料夾,存放3個EXCEL檔,每份表格的首欄為標題,分別有地點,姓名,加班費,差旅費,雜費,租賃費,其它 欄位,每個表格的首欄標題位置皆不同,請寫PYTHON程式
,將3個EXCEL表格,合併成 MergeOK.XLSX



import pandas as pd

# File paths 甲分公司檔名為file1.xlsx 、乙分公司檔名為file2.xlsx、丙分公司檔名為file3.xlsx


folder_path = 'D:/總公司/'
file_names = ['file1.xlsx', 'file2.xlsx', 'file3.xlsx']

# Read each Excel file into a DataFrame
dfs = []
for file_name in file_names:
    file_path = folder_path + file_name
    df = pd.read_excel(file_path)
    dfs.append(df)

# Merge the DataFrames
merged_df = pd.concat(dfs)

# Save the merged DataFrame to a new Excel file
output_file = folder_path + 'MergeOK.xlsx'
merged_df.to_excel(output_file, index=False)



相關查詢:
How to join Excel data from Multiple files?

複数のExcelファイルを1つにまとめる方法?


後記:
合併多個EXCEL檔成單一檔方法很多,可以用EXCEL本身功能,或用VBA、或用PYTHON,如果要改成VBA,本範例是用PYHTON,如要使用VBA,只要將PROMPT提示訊息下法,將上面  請寫PYTHON程式  ,改成 EXCEL VBA程式即可

2023年12月4日 星期一

VLOOKUP 查詢對應資料有誤

發現VLOOKUP回傳對應資料有誤

原因分析:
1.拚字錯誤  ,如:參照對應陣列關鍵字1o4 ,而其查詢來源為 104,
                           參照對應陣列關鍵字,部分字示為全形字元,而其來源全為半形字元
   ,導致欲查詢之關鍵字,與參照對應陣列值回傳錯誤

2.格式不同,如:參照對應陣列關鍵字,欄位之儲存格格式,類別(C):屬性為文字,而其來源欄位之儲存格格式,類別(C):屬性為數值 


3.CELLS 儲存格,內含 看不到多餘的空白字元^^^(例如:NBSP空白字元CHR(160),&NBSP;),如:參照對應陣列關鍵字104^^^ ,而其來源為 104,原因多了看不到的3個空白字元(NBSP、CR、LF),導致vlookup回傳對應資料錯誤 

解決辦法:
可以透過trim函數或 substitue函數,去除CELLS儲存格多餘空白字元 ,trim(參照對應陣列關鍵字欄位),即可將參照對應陣列關鍵字,去除多餘空白字元.


相關查詢:
https://myblog-johnnyit.blogspot.com/2008/04/vlookup.html


2023年11月27日 星期一

編輯EXCEL巨集,出現'VBE6EXT. OLB could not be loaded'

問題

編輯EXCEL巨集程式,出現錯誤訊息VBE6EXT無法載入問題

 

處理方式

1.將VBE6EXT.OLB ,更名成 VBE6EXT.OLD (無效) 

2.重新修復OFFICE(無效)

3.移除OFFICE重裝(無效) 


解決方式

步驟1.確認下列檔案路徑,是否確實有VBE6EXT.OLB ?

C:\Program Files (x86)\Common Files\Microsoft shared\VBA\VBA6\

 

OFFICE版本不同可能會不同位置

C:\Program Files (x86)\Microsoft Office\root\VFS\Program Files Common X86 \ Microsoft Shared \ VBA\VBA

步驟2. REGEDIT 機碼位址

以下,另儲存REG附加檔名

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\TypeLib\{0002E157-0000-0000-C000-000000000046}]

[HKEY_CLASSES_ROOT\TypeLib\{0002E157-0000-0000-C000-000000000046}\5.3]
@="Microsoft Visual Basic for Applications Extensibility 5.3"
"PrimaryInteropAssemblyName"="Microsoft.Vbe.Interop, Version=15.0.0.0, Culture=neutral, PublicKeyToken=71E9BCE111E9429C"

[HKEY_CLASSES_ROOT\TypeLib\{0002E157-0000-0000-C000-000000000046}\5.3\0]

[HKEY_CLASSES_ROOT\TypeLib\{0002E157-0000-0000-C000-000000000046}\5.3\0\Win32]
@="C:\\Program Files (x86)\\common Files\\Microsoft Shared\\VBA\\VBA6\\VBE6EXT.OLB"

[HKEY_CLASSES_ROOT\TypeLib\{0002E157-0000-0000-C000-000000000046}\5.3\Flags]
@="0"

[HKEY_CLASSES_ROOT\TypeLib\{0002E157-0000-0000-C000-000000000046}\5.3\HelpDir]
@="C:\\Program Files (x86)\\common Files\\Microsoft Shared\\VBA\\VBA6\\VBE6EXT.OLB"
 
確認VBE6EXT.OLD機碼,是否對應正確?,步驟1之路徑
步驟3.重新開機 
原因分析:安裝其它OFFICE軟體,又移除不完全,導致機碼錯亂所致
相關查詢

VBE6EXT.OLBを読み込めません

 

2022年1月13日 星期四

以PowerShell指令查詢Outlook之GAL全域通訊清單


步驟1:執行cmder程式,
步驟1-1:按+ Create new console
步驟1-2:選1:{Shells}
步驟1-3:選6:{PowerShells(Admin)}


步驟2: 將下列指令,逐行貼上 (註解: 

第3行  | where {$_ -match '@taipei.abc.com.tw'}  表示篩選ABC公司之台北分支辦公室 、

           | Sort-Object -Property department  以部門別排序後再產出結果  )

 

$OUTLOOK = New-Object -ComObject "Outlook.application"

$Galist=$outlook.getnamespace("MAPI").AddressLists.Item("全域通訊清單").AddressEntries

$Galist|%{$_.GetExchangeUser() |select companyname,department,Name,PrimarySmtpAddress,BusinessTelephoneNumber,JobTitle} | where {$_ -match '@taipei.abc.com.tw'}  | Sort-Object -Property department > c:\users\username\Gal_Taipei.txt


步驟3:檢視C槽資料夾,產出結果 c:\users\username\Gal_Taipei.txt


相關介面:
cmder命令提示字元(PowerShell)


相關GAL查詢
EXCEL VBA執行GAL查詢



2018年10月26日 星期五

以命令提示方式,將OFFICE轉成ODF開放格式檔

LibreOfficeのコマンドライン変換機能を使ってODF、ODTを作成する。
命令提示列,無需開啟主程式,即可轉換OFFICE檔案,成 開放格式檔。



Step1:下載 ODF文件應用工具

Step2:安裝 NDC ODF Application Tools

Step3:將下面紅色部分,貼於記事本(Notepad.exe)中,並另存新檔名至桌面成ConvertOffice2ODF.cmd

@echo off
setlocal
cd /d %~dp0

rem 如附加檔為XLSX格式,則至XLSX_ODS1位置執行轉換
if %~x1 EQU .xlsx  goto XLSX_ODS
if %~x1 EQU .xls  goto  XLS_ODS
if %~x1 EQU .docx goto  DOCX_ODT
if %~x1 EQU .doc  goto  DOC_ODT
if %~x1 EQU .CSV  goto  DOCX_ODT

:non_Office
echo "本批次檔,僅供轉換WORD及EXCEL "
pause
goto end

:DOCX_ODT
start /wait soffice --headless --convert-to odt %1 --outdir %userprofile%\desktop
goto end

:DOC_ODT
start /wait soffice --headless --convert-to odt %1 --outdir %userprofile%\desktop
goto end

rem 執行轉換成ODS格式
:XLSX_ODS
start /wait soffice --headless --convert-to ods %1 --outdir %userprofile%\desktop
goto end

:XLS_ODS
start /wait soffice --headless --convert-to ods %1 --outdir %userprofile%\desktop
goto end

:end
REM 以檔案總管,開啟 桌面,並查詢剛產出之ODF、ODS檔
explorer %userprofile%\desktop



Step4:
將欲合併之檔案,Drag and drop拖放至桌面 ConvertOffice2ODF.cmd上方,即可自動合併成單一ODF/ODS檔




新增右鍵開啟(),將下列紫色部分
Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\*\shell\2_OpenDocument]
@="Convert Office to OpenDocument(ODF/ODS)"

[HKEY_CLASSES_ROOT\*\shell\2_OpenDocument\command]
@="d:\\ODF\\ConvertOffice2ODF.cmd \"%1\""

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\*\shell\2_OpenDocument]
@="Convert Office to OpenDocument(ODF/ODS)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\*\shell\2_OpenDocument\command]
@="d:\\ODF\\ConvertOffice2ODF.cmd \"%1\""



相關檔案下載:

2018年1月4日 星期四

Merge Multiple PDF in one

如何快速將所有之PDF檔案,轉換成單一PDF檔?
複数のWORDのファイルをひと一つのPDFにまとめる方法

Step1:下載GhostScript合併PDF工具

Step2:解壓縮 將其bin路徑下之檔案(如:gswin32c.exe及相關dll檔),拷貝至c:\windows\system32(或PATH路徑下指定相關執行目錄)

Step3:將下面紅色部分,貼於記事本(Notepad.exe)中,並另存新檔名至桌面成MergeAllPDFinOne.cmd
setlocal
gswin32c -dBATCH -dNOPAUSE -q -sDEVICE=pdfwrite -dCompatibilityLevel=1.5 -sOutputFile="%1"MergedALL.PDF %1 %2 %3 %4 %5 %6 %7 %8  %9 

Step4:
將欲合併之檔案,Drag and drop拖放至桌面 MergeAllPDFinOne.cmd上方,即可自動合併成單一PDF檔

相關查詢:
將目錄(含全數之子目錄)中 ,所有Office檔案,自動轉換成PDF檔案
檔案參數傳送超過10個以上查詢,
自訂滑鼠右鍵(將MergeAllPDFinOne.cmd,拷貝至shell:sendto)新增合併PDF成單一檔,只要一次將全數PDF選好後,按下右鍵 合併PDF成單一檔,即可快速完成所有PDF轉換成單一PDF檔

缺點:拖拉方式不方便控制PDF檔案合併順序,
備註:可以命令提示列方式 MergeAllPDFinOne.cmd Page2.pdf Page1.pdf Page3.pdf 手動指定合併順序 

2018年1月1日 星期一

Batch Convert PDF大批OFFICE檔轉PDF檔

自動將目錄中(含其子目錄)所有OFFICE檔案,自動轉換成PDF檔案?

Scenario(シナリオ):家中小孩考試前列印學校之歷屆考題,有WORD檔,也有是PDF檔,但處理列印工作時,PDF檔案列印(SumatraPdfReader)與WORD檔列印相較,個人傾向使用PDF列印。
問題來了,每年級(3個年級)有上下學期,每學期又分成3次段考,又細分國/英/數/社/自(理化/地科)等解開壓縮檔後,從100年~106年WORD檔要轉換成PDF檔就是相當可觀的轉換工作。

Office文書(複数のWordファイルに)を一括でPDFにする
Solution辦法:以Batch File大批處理Office轉換成PDF
步驟ステップ1:
下載OfficeToPDF並解壓縮至c:\windows\system32   (讓該檔變全域,即可在電腦任何目錄均可叫的到OfficeToPDF)

步驟ステップ2:
將下面程式(如紅色部分),貼至 記事本(notepad.exe) ,另存成 Doc2PDF.bat 
setlocal
cd /d %~dp0
For /R %%X in (*.doc) do OfficeToPDF "%%X" "%%~nX.pdf"


步驟ステップ3:
Doc2PDF.bat 拷貝(COPY)至歷屆試題目錄下執行,它即可自動將所有子目錄中之WORD檔轉換成PDF檔案(包含所有的子目錄,即國/英/數/社/自等目錄)

註:
1. 因OfficeToPDF不限處理DOC,故亦可轉換XLS 、PPT等,只要將步驟2  (*.doc),改成 (*.xls)等,就可轉換其他類型之OFFICE檔案成PDF檔
2.有時轉換可能會因WORD開啟卡住,建議採一次段考為範圍之目錄進行轉換(即步驟3動作,將批次檔COPY至該目錄執行)。

相關查詢:

如何將多數PDF檔合併成單一PDF檔,
(GNU GPL)HTTRack歷屆試題下載工具(輸入學校歷屆試題網址後,即可一次全數下載下來),

Office轉PDF命令提示CLI工具介紹

Apache License 2.0 (Apache)
OfficeToPDF 以命令提示列方式,將Office相關類型檔案(如:DOC、XLS、PPT等)轉換成PDF檔,或
                       可建立捷徑,將欲轉換之檔案,拖拉至OfficeToPDF捷徑上,無需開啟讓OFFICE檔案即可產出PDF檔。
步驟ステップ1:
下載並解壓縮,OfficeToPDF

步驟ステップ2:
建立OfficeToPDF至桌面,做成 捷徑。
デスクトップに置いていたショートカット

步驟ステップ3:直接將OFFICE檔,拖曳至該OfficeToPDF,即可轉換成PDF檔 (限制:一次最多僅能拖拉1個檔,否則原始檔可能會有問題)
ドラッグ・アンド・ドロップで 置いていたショートカット(OfficeToPDF)
   "OfficeToPDF"   


增設判斷機制,限制一次僅能轉換一個檔案作法:

  • 開啟記事本(Notepad.exe),將下面紫色部分程式貼上後,另存成ConvertOffice2PDF.wsh

<  job id="Convertto_pdffile"  >
 <  script language="JScript"  >
    var fso = new ActiveXObject("Scripting.FileSystemObject");
    var shell = WScript.CreateObject("Shell.Application");

    if (WScript.Arguments.length >=2) {
        WScript.Echo("Sorry! 一次僅能處理單一檔案轉換!");
      
       // Destroy and de-reference FileSystemObject
       delete fso;
       fso = null;

       WScript.Quit();
    }

      //debug print
      //WScript.Echo (WScript.Arguments(0));


   shell.ShellExecute ("c://windows//system32//OfficeToPDF.exe", WScript.Arguments(0), "", "", 1);
         
       // Destroy and de-reference FileSystemObject
       delete fso;
       fso = null;
   
     WScript.Quit();

  </ script >
</   job   >

 
  • 備註:上面附檔WSH程式,會去找轉檔程式 c:\windows\system32\OfficeToPDF.exe ,故需於步驟ステップ1請解壓縮至c:\windows\system32

相關查詢:Convert DOC to PDF from Command Line
支援轉換類型檔:Office 2016, 2013, 2010 or Office 2007 
相關應用:
大批OFFICE檔轉PDF檔

2017年12月18日 星期一

WORD合併套印,(資料來源為EXCEL)



WORD合併套印,(資料來源為EXCEL)
EXCEL資料內容如下:

公司名            產品名         產品價格

A公司            產品A1           100

A公司            產品A2           100

B公司            產品B1           100

B公司            產品A2           100

產出Word報表,如下:   (分別以每家公司為1個單位,將該家公司所有產品列印到1張報表)
公司名           產品名         產品價格

A公司           產品A1           100

A公司           產品A2           100
        分頁符號  Page Break- - - - - - - -

公司名           產品名         產品價格

B公司           產品B1           100

B公司           產品B2           100

功能變數設定如下:
{IF{MERGESEQ}=”1” “{MERGEFIELD 公司名}” “”}{SET BookMark1 {MERGEFIELD 公司名}}{IF BookMark2}<>{BookMark1}”
--------Page Break --------------
   公司名                    產品名                     產品價格
{MERGEFIELD 公司名}{MERGEFIELD 產品名}{MERGEFIELD 產品價格}
“ “
{MERGEFIELD 公司名}{MERGEFIELD 產品名}{MERGEFIELD 產品價格} “}{SET BookMark2 {MERGEFIELD 公司名}}
 
錯誤問題(If mail merge , does not work. Please check the following):無法同家公司之多筆產品名列印於同1張。
Debug除錯: (WORD功能變數及書籤功能)
Step1確認WORD文件之書籤是否定義正確?(有可能捉不
到來源資料,需再次指定主文件之來源)
Step2於主文件WORD中,按Shift+F9進入切換功能變數代碼(T),並於功能變數{MERGEFIELD 公司名}(以本件為例有3處需確認),點選滑鼠右鍵,選擇編輯功能變數(E)」。
Step3功能變數視窗」中,確認「功能變數名稱(F)」為MergeField,按確定後,
       跳出「無效的合併欄」,確認視窗右下方「資料來源之欄位(F)」,是否為公司名,因為WORD會去比對書籤BookMark2及書籤BookMark1,才可正確找出公司A與公司B之接續點,並設好分頁PageBreak

{ IF 表示式1運算元表示式2  結果為真的文字  結果為假的文字}
{IF order>=100 "感謝您" "訂購數量,最小以100為單位為基準"}

欄位一為1者,印出Y,另一邊呈現剛好相反
{IF {Mergefield 欄位一} =1  "Y"  "N"} {IF {Mergefield 欄位一} =1  "N" "Y"}

相關快速鍵:
ALT+F9 -->切換檢視功能變數代碼和功能變數代碼結果。
Ctrl+F9-->於微軟OFFICE文件,插入功能變數(Field Codes)  {  }
Ctrl+Enter-->插入分頁符號(Page Break) 

資料來源:

 相關查詢: