[已解决]excel 找尋關鍵字設定刪除線和欄位變色

ipmitool · 发表于 2019-10-22 17:40:10

本帖最后由 ipmitool 于 2019-10-23 13:57 编辑

我寫了一個excel finding and replace的工具, 想要讓finding的文字變成刪除線, 然後設定成整格綠色, 不曉得有辦法嗎? 謝謝

Excel_0001

另存成新的excel檔案

#include <GDIPlus.au3>
#include <Misc.au3>
#include <Date.au3>
#include <GUIConstants.au3>
;#include <ServiceControl.au3>
;#include <Excel1.au3>
#include <File.au3>
#include <Array.au3>
#include <Excel.au3>
#include <MsgBoxConstants.au3>

#include <FileConstants.au3>
#include <MsgBoxConstants.au3>
#include <WinAPIFiles.au3>
#include <File.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <GuiButton.au3>
#include <Array.au3>
#include <GDIPlus.au3>
#include <Misc.au3>
#include <Date.au3>
#include <GUIConstants.au3>



Opt('MustDeclareVars', 1)
Opt("TrayMenuMode", 1)

Global $MinimalGUI, $DTUser, $DateTime, $Group, $B001Label, $B001, $B001Data, $A001Label, $A001, $A001Data, $ActionPerformedLabel, $ActionPerformed, $ActionPerformedData, $ExplanationLabel, $Explanation, $ExplanationData, $SubmitLog, $nMsg, $LogData, $FullGUI, $FilenameWextensionLabel, $FilenameWextension, $FilenameWextensionData, $Result
Global $IP_Address = @IPAddress1

Global $OS_Version = @OSVersion
Global $UserName = @UserName


; =======================================================================
; Command Line Interpretation
; =======================================================================
If $CmdLine[0] = 0 Then ;gui mode

    $FullGUI = GUICreate("Excel Search and Replace Tool v1.0", 640, 500, -1, -1, -1, $WS_EX_ACCEPTFILES)
    Global $idFilemenu = GUICtrlCreateMenu("&File")
    Global $idExititem = GUICtrlCreateMenuItem("Exit", $idFilemenu)
    Global $idHelpmenu = GUICtrlCreateMenu("Help")
    Global $idUserGuide = GUICtrlCreateMenuItem("User Guide", $idHelpmenu)
    $DTUser = GUICtrlCreateLabel("Approved Username: " & $UserName, 25, 10, 400, 24)
    GUICtrlSetFont(-1, 11 * _GDIPlus_GraphicsGetDPIRatio()[0], 600, 0, "Calibri")
    $DateTime = GUICtrlCreateLabel(_Now(), 440, 10, 175, 24, $SS_RIGHT)
    GUICtrlSetFont(-1, 10 * _GDIPlus_GraphicsGetDPIRatio()[0], 600, 0, "Calibri")
    $Group = GUICtrlCreateGroup("Please complete the fields below.", 25, 40, 593, 420)
    GUICtrlSetFont(-1, 9 * _GDIPlus_GraphicsGetDPIRatio()[0], 600, 0, "Calibri")
    DllCall("UxTheme.dll", "int", "SetWindowTheme", "hwnd", GUICtrlGetHandle($Group), "wstr", 0, "wstr", 0)
    GUICtrlSetColor(-1, 0xFF0000)
    GUICtrlCreateGroup("", -99, -99, 1, 1)

    $A001Label = GUICtrlCreateLabel("Finding Word:", 35, 66, 250, 24)
    GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio()[0], 400, 0, "Calibri")
    $A001 = GUICtrlCreateInput("", 35, 89, 215, 24)


    GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio()[0], 400, 0, "Calibri")


    $B001Label = GUICtrlCreateLabel("Replace Word:", 260, 66, 200, 24)
    GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio()[0], 400, 0, "Calibri")
    $B001 = GUICtrlCreateInput("", 260, 89, 180, 24)



    GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio()[0], 400, 0, "Calibri")
    $FilenameWextensionLabel = GUICtrlCreateLabel("File name/s with extension", 35, 125, 480, 24)
    GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio()[0], 400, 0, "Calibri")
    $FilenameWextension = GUICtrlCreateEdit("", 35, 150, 575, 155, BitOR($ES_WANTRETURN, $ES_AUTOVSCROLL, $WS_VSCROLL, $ES_MULTILINE))
    GUICtrlSetState(-1, $GUI_DROPACCEPTED)
    GUICtrlSetFont(-1, 9 * _GDIPlus_GraphicsGetDPIRatio()[0], 400, 0, "Calibri")
    GUICtrlSendMsg($FilenameWextension, $EM_LIMITTEXT, -1, 0)


    GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio()[0], 400, 0, "Calibri")
    $SubmitLog = GUICtrlCreateButton("Execute", 460, 58, 149, 56, $BS_MULTILINE)
    GUICtrlSetFont(-1, 14 * _GDIPlus_GraphicsGetDPIRatio()[0], 500, 0, "Calibri")

    ;GUICtrlSetBkColor($DTUser, 0xFFFFBF) ;For testing
    GUICtrlSetBkColor($A001, 0xFFFFBF)
    GUICtrlSetBkColor($B001, 0xFFFFBF)
    GUICtrlSetBkColor($FilenameWextension, 0xFFFFBF)
    ;GUICtrlSetBkColor($FilenameWextensionLabel, 0xFFFFBF)
    GUICtrlSetBkColor($ActionPerformed, 0xFFFFBF)
    GUICtrlSetBkColor($Explanation, 0xFFFFBF)

    GUISetState(@SW_SHOW)

    While 1
        $nMsg = GUIGetMsg()
        Switch $nMsg
                        Case $SubmitLog




                $A001Data = GUICtrlRead($A001)
                $B001Data = GUICtrlRead($B001)
                $FilenameWextensionData = GUICtrlRead($FilenameWextension)
                $ActionPerformedData = GUICtrlRead($ActionPerformed)
                $ExplanationData = GUICtrlRead($Explanation)

                GUISetState(@SW_SHOW)

                $LogData = "Finding Word: "&GUICtrlRead($A001)&@CRLF&"Replace Word: "&GUICtrlRead($B001)&  @CRLF&@CRLF& "File Name:" &@CRLF&  $FilenameWextensionData & @CRLF
                MsgBox(0, "LogData", $LogData)

    ProgressOn("Progress Meter", "Increments every second", "0%")
        ProgressSet(0, "0%")

                                FileDelete(@ScriptDir&"\log.txt")
                                filewrite(@ScriptDir&"\log.txt",$FilenameWextensionData)

        ProgressSet(20, "20%")

                Local $file11,$line
                $file11 = @ScriptDir&"\log.txt"
                FileOpen($file11, 0)

                For $i = 1 to _FileCountLines($file11)
                        $line = FileReadLine($file11, $i)
                ;msgbox(0,'Reading File Name','The File ' & $i & ' is ' & $line)

        ProgressSet(30+$i, 30+$i&"%")


                Local $path,$pPath
                $path= $line
                $pPath = StringRegExp($path, "\\([^\\]+)\\*.xls*", 3)

       ; MsgBox(0, 0, $pPath[0])







                ; Create application object and open an example workbook
                Local $oExcel = _Excel_Open(False)
                If @error Then Exit MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_RangeReplace Example", "Error creating the Excel application object." & @CRLF & "@error = " & @error & ", @extended = " & @extended)
                Local $oWorkbook = _Excel_BookOpen1($oExcel, $line)

                If @error Then
                        MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_RangeReplace Example", "Error opening workbook '" & $line& @CRLF & "@error = " & @error & ", @extended = " & @extended)
                        _Excel_Close($oExcel)
                        Exit
                EndIf



                ; *****************************************************************************
                ; Find all cells with text "long " and remove it (replace with "")
                ; *****************************************************************************
                ;MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_RangeReplace Example 1", "Press OK to modify data in cell 'G1'.")
                _Excel_RangeReplace($oWorkbook, Default, Default, GUICtrlRead($A001), GUICtrlRead($A001)&@CRLF&GUICtrlRead($B001))
If _Excel_RangeRead($oWorkbook,default, "G1:G50",2) = "long" Then _ExcelFontSetProperties($oWorkbook, 1,    1,    100,   100, "微软雅黑", True, False, 10,  False,  5,  18,  10,  "center")

                _Excel_BookSaveAs($oWorkbook, @ScriptDir & ""&$pPath[0]&"_"&@YEAR&@MON&@MDAY&"_"&@HOUR&@MIN&@SEC&".xlsx", Default, True)
                _Excel_BookClose($oWorkbook,True)

                ;_Excel_BookSaveAs($oWorkbook, @ScriptDir, $xlHtml, True)

                If @error Then Exit MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_RangeReplace Example 2", "Error replacing data the range." & @CRLF & "@error = " & @error & ", @extended = " & @extended)
                ;MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_RangeReplace Example 2", "Replace text to '"&GUICtrlRead($B001) &"'" &@CRLF &@CRLF & " Data successfully replaced.")






Next


        ProgressSet(90, "90%")


                FileClose($file11)


    ProgressSet(100, "Done", "Complete")
    Sleep(1000)

    ; Close the progress window.
    ProgressOff()



                MsgBox(0,"Message","Done!")



                Exit




            Case $idUserGuide
                MsgBox(0, "Message", "The user guide is not quite ready.")
                ContinueLoop
            Case $GUI_EVENT_CLOSE, $idExititem
                Exit
        EndSwitch
    WEnd
Else
    _Terminate()
EndIf












Func _Excel_BookOpen1($oExcel, $sFilePath, $bReadOnly = Default, $bVisible = Default, $sPassword = Default, $sWritePassword = Default, $bUpdateLinks = Default)
    ; Error handler, automatic cleanup at end of function
    Local $oError = ObjEvent("AutoIt.Error", "__Excel_COMErrFunc")
    #forceref $oError
    If Not IsObj($oExcel) Or ObjName($oExcel, 1) <> "_Application" Then Return SetError(1, @error, 0)
    If Not FileExists($sFilePath) Then Return SetError(2, 0, 0)
    If $bReadOnly = Default Then $bReadOnly = False
    If $bVisible = Default Then $bVisible = True
    Local $oWorkbook = $oExcel.Workbooks.Open($sFilePath, $bUpdateLinks, $bReadOnly, Default, $sPassword, $sWritePassword)
    If @error Then Return SetError(3, @error, 0)
    Local $oWindow = $oExcel.Windows($oWorkbook.Name) ; <== Modified
    If IsObj($oWindow) Then $oWindow.Visible = $bVisible ; <== Modified
    ; If a read-write workbook was opened read-only then set @extended = 1
    If $bReadOnly = False And $oWorkbook.Readonly = True Then Return SetError(0, 1, $oWorkbook)
    Return $oWorkbook
EndFunc   ;==>_Excel_BookOpen







; #FUNCTION# ====================================================================================================================
; Name ..........: _GDIPlus_GraphicsGetDPIRatio
; Description ...: Get DPI Ratio
; Syntax ........: _GDIPlus_GraphicsGetDPIRatio([$iDPIDef = 96])
; Parameters ....: $iDPIDef             - [optional] An integer value. Default is 96.
; Return values .: actual DPI Ratio as Array, or set @error to non zero, also @extended may be set
; Author ........: UEZ
; Modified ......: argumentum 2015.06.05 / better error return
; Remarks .......:
; Related .......:
; Link ..........: https://www.autoitscript.com/forum/topic/166479-writing-dpi-awareness-app-workaround/
; Example .......: yes
; ===============================================================================================================================
Func _GDIPlus_GraphicsGetDPIRatio($iDPIDef = 96)
    Local $aResults[2] = [1, 1]
    _GDIPlus_Startup()

    Local $hGfx = _GDIPlus_GraphicsCreateFromHWND(0)
    If @error Then Return SetError(1, @extended, $aResults)

    Local $aResult
    #forcedef $__g_hGDIPDll, $ghGDIPDll
    $aResult = DllCall($__g_hGDIPDll, "int", "GdipGetDpiX", "handle", $hGfx, "float*", 0)
    If @error Then Return SetError(2, @error, $aResults)

    Local $iDPI = $aResult[2]
    Local $aResults[2] = [$iDPIDef / $iDPI, $iDPI / $iDPIDef]
    _GDIPlus_GraphicsDispose($hGfx)
    _GDIPlus_Shutdown()
    Return $aResults

EndFunc   ;==>_GDIPlus_GraphicsGetDPIRatio


;Ref https://www.autoitscript.com/forum/topic/165393-get-mac-address-efficiently/
Func GET_MAC($_MACsIP)
    Local $_MAC, $_MACSize
    Local $_MACi, $_MACs, $_MACr, $_MACiIP
    $_MAC = DllStructCreate("byte[6]")
    $_MACSize = DllStructCreate("int")
    DllStructSetData($_MACSize, 1, 6)
    $_MACr = DllCall("Ws2_32.dll", "int", "inet_addr", "str", $_MACsIP)
    $_MACiIP = $_MACr[0]
    $_MACr = DllCall("iphlpapi.dll", "int", "SendARP", "int", $_MACiIP, "int", 0, "ptr", DllStructGetPtr($_MAC), "ptr", DllStructGetPtr($_MACSize))
    $_MACs = ""
    For $_MACi = 0 To 5
        If $_MACi Then $_MACs = $_MACs & ":"
        $_MACs = $_MACs & Hex(DllStructGetData($_MAC, 1, $_MACi + 1), 2)
    Next
    DllClose($_MAC)
    DllClose($_MACSize)
    Return $_MACs
EndFunc   ;==>GET_MAC

Func _Terminate()
    Exit (0)
EndFunc   ;==>_Terminate

zch11230 · 发表于 2019-10-22 19:27:03

分享一个如何实现excel自带UDF之外的功能，首先开启开发者选项，然后选择录制宏，把自己想要实现的功能操作一遍，停止录制，然后点宏编辑，看一下是用了哪些方法，然后MSDN查资料，最后套用到AU3中。

kevinch · 发表于 2019-10-23 09:22:25

查找并设置删除线及单元格颜色的代码示例

Dim $oExcel,$oXls,$oWs,$oRng,$oRg,$sFN
Dim $findStr,$n,$i

Const $findPart=2  ;匹配单元格部分内容
Const $matchCase=False  ;不区分大小写

$sFN=@ScriptDir&"\ExcelFind.xlsx"
$findStr="test"
$oExcel=ObjCreate("excel.application")
$oExcel.visible=True
;$oExcel.screenupdating=False  ;关闭屏幕刷新，需要提速时取消注释
$oXls=$oExcel.workbooks.open($sFN)
With $oXls
        For $oWs In .worksheets  ;循环各个工作表
                $oRng=$oWs.cells.find($findStr,Default,Default,$findPart,Default,Default,$matchCase,Default)  ;查找第一个符合的单元格
                If IsObj($oRng) Then
                        $oRg=$oRng  ;记录第一个单元格
                        Do
                                If IsNumber($oRg.value) Then  ;如果单元格内容是数值，则调整单元格内容为文本，并将内容赋值为显示内容，否则数值单元格无法设置部分文本不同的字体
                                        $oRg.numberformatlocal="@"
                                        $oRg.value=$oRg.text
                                EndIf
                                $oRg.interior.color=0x00FF00  ;设置单元格底色
                                $i=1
                                Do  ;循环处理找到的单元格，直到回到初始单元格为止
                                        If $matchCase Then  ;处理区分大小写的情况
                                                $n=StringInStr($oRg.value,$findStr,1,1,$i)
                                        else
                                                $n=StringInStr($oRg.value,$findStr,0,1,$i)
                                        EndIf
                                        If $n>0 Then  ;如果当前查找区段有对应文本，则设置文字删除线，交白后移起始查找位置
                                                $oRg.characters($n,StringLen($findStr)).font.strikethrough=true
                                                $i=$n+StringLen($findStr)
                                        EndIf
                                Until $n=0
                                $oRg=$oWs.cells.findnext($oRg)  ;查找下一个符合的单元格
                        Until $oRg.address=$oRng.address
                EndIf
        Next
EndWith
$oXls.close(true)  ;保存并关闭文件
$oExcel.quit  ;退出excel进程

Dontang2018 · 发表于 2019-10-23 10:44:08

学习一下,学习一下.

ipmitool · 发表于 2019-10-23 11:21:08

kevinch 发表于 2019-10-23 09:22
查找并设置删除线及单元格颜色的代码示例

大哥好厲害啊我搞定了, 不過做的時候可以不要打開視窗嗎? 背景讓他執行要怎麼做啊? 謝謝i

kevinch · 发表于 2019-10-23 11:40:10

ipmitool 发表于 2019-10-23 11:21
大哥好厲害啊我搞定了, 不過做的時候可以不要打開視窗嗎? 背景讓他執行要怎麼做啊? 謝謝i

$oExcel.visible=false

ipmitool · 发表于 2019-10-23 13:57:31

kevinch 发表于 2019-10-23 11:40
$oExcel.visible=false

感謝大哥, 全部都解決了, 你好厲害

ipmitool · 发表于 2019-10-23 14:56:32

本帖最后由 ipmitool 于 2019-10-23 14:57 编辑

kevinch 发表于 2019-10-23 09:22
查找并设置删除线及单元格颜色的代码示例

想問一下, 如果要在刪除線的文字後面加文字($123)可以嗎?$123="ABCDEFG"
讓執行出來變成下面這樣, 在同一格內.

long
ABCDEFG

long <- 有刪除線
ABCDEFG <- 沒有刪除線

kevinch · 发表于 2019-10-23 15:13:17

ipmitool 发表于 2019-10-23 14:56
想問一下, 如果要在刪除線的文字後面加文字($123)可以嗎?$123="ABCDEFG"
讓執行出來變成下面這樣, 在同 ...

先替换单元格内容，再设置删除线

ipmitool · 发表于 2019-10-23 16:02:46

kevinch 发表于 2019-10-23 15:13
先替换单元格内容，再设置删除线

對這個excel處理不太熟, 想請問一下如何替换单元格, 謝謝您...

kevinch · 发表于 2019-10-23 16:09:32

ipmitool 发表于 2019-10-23 16:02
對這個excel處理不太熟, 想請問一下如何替换单元格, 謝謝您...

你想复杂了，单元格读取出来的文本替换好再写回去就行了

ipmitool · 发表于 2019-10-23 16:22:30

kevinch 发表于 2019-10-23 16:09
你想复杂了，单元格读取出来的文本替换好再写回去就行了

大哥, 我有點搞不懂要用甚麼語法? 用 StringReplace這個嗎?

ipmitool · 发表于 2019-10-23 16:56:43

本帖最后由 ipmitool 于 2019-10-23 17:06 编辑

可以了, 謝謝耶~

#include <GDIPlus.au3>
#include <Misc.au3>
#include <Date.au3>
#include <GUIConstants.au3>
;#include <ServiceControl.au3>
;#include <Excel1.au3>
#include <File.au3>
#include <Array.au3>
#include <Excel.au3>
#include <MsgBoxConstants.au3>

#include <FileConstants.au3>
#include <MsgBoxConstants.au3>
#include <WinAPIFiles.au3>
#include <File.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <GuiButton.au3>
#include <Array.au3>
#include <GDIPlus.au3>
#include <Misc.au3>
#include <Date.au3>
#include <GUIConstants.au3>




Dim $oExcel,$oXls,$oWs,$oRng,$oRg,$sFN
Dim $findStr,$n,$i

Const $findPart=2  ;匹配单元格部分内容
Const $matchCase=False  ;不区分大小写

$sFN=@ScriptDir&"\001.xlsx"
$findStr="long"
$findNew="AAA"
$FilenameWextension="D:\Autoit\Autoit_Excel_replace\Excel_0001.xlsx"

$LogData = "Finding Word: "&$findStr&@CRLF&"Replace Word: "&$findNew&  @CRLF&@CRLF& "File Name:" &@CRLF&  $FilenameWextension & @CRLF
                MsgBox(0, "LogData", $LogData)


$oExcel=ObjCreate("excel.application")
$oExcel.visible=True
;$oExcel.screenupdating=False  ;关闭屏幕刷新，需要提速时取消注释
$oXls=$oExcel.workbooks.open($sFN)
With $oXls


        For $oWs In .worksheets  ;循环各个工作表

; *****************************************************************************
                ; Find all cells with text "long " and remove it (replace with "")
                ; *****************************************************************************
                ;MsgBox($MB_SYSTEMMODAL, "Excel UDF: _Excel_RangeReplace Example 1", "Press OK to modify data in cell 'G1'.")
                _Excel_RangeReplace($oXls, $oWs+1, Default, $findStr, $findStr&@CRLF&$findNew)



                $oRng=$oWs.cells.find($findStr,Default,Default,$findPart,Default,Default,$matchCase,Default)  ;查找第一个符合的单元格
                If IsObj($oRng) Then
                        $oRg=$oRng  ;记录第一个单元格



                        Do

                               If IsNumber($oRg.value) Then  ;如果单元格内容是数值，则调整单元格内容为文本，并将内容赋值为显示内容，否则数值单元格无法设置部分文本不同的字体
                                        $oRg.numberformatlocal="@"
                                        $oRg.value=$oRg.text
                                                           EndIf


                                $oRg.interior.color=0x00FF00  ;设置单元格底色
                                $i=1




                                                                Do  ;循环处理找到的单元格，直到回到初始单元格为止
                                        If $matchCase Then  ;处理区分大小写的情况
                                                $n=StringInStr($oRg.value,$findStr,1,1,$i)

                                        else
                                                $n=StringInStr($oRg.value,$findStr,0,1,$i)

                                        EndIf
                                        If $n>0 Then  ;如果当前查找区段有对应文本，则设置文字删除线，交白后移起始查找位置

                                                                                                $oRg.characters($n,StringLen($findStr)).font.strikethrough=true
                                                $i=$n+StringLen($findStr)
                                        EndIf

                                                                Until $n=0

                                $oRg=$oWs.cells.findnext($oRg)  ;查找下一个符合的单元格



                                                Until $oRg.address=$oRng.address


                EndIf

                Next

EndWith
;$oXls.close(true)  ;保存并关闭文件
;$oExcel.quit  ;退出excel进程

zmdzhxj · 发表于 2019-10-23 21:37:43

感谢两位，学习了！

chzj589 · 发表于 2019-10-27 11:16:08

这样更好玩

		自动登录	找回密码
密码			加入

[网络通信] [已解决]excel 找尋關鍵字設定刪除線和欄位變色

本帖子中包含更多资源

本帖子中包含更多资源