[已解决]excel 找尋關鍵字設定刪除線和欄位變色
本帖最后由 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 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(), 600, 0, "Calibri")
$DateTime = GUICtrlCreateLabel(_Now(), 440, 10, 175, 24, $SS_RIGHT)
GUICtrlSetFont(-1, 10 * _GDIPlus_GraphicsGetDPIRatio(), 600, 0, "Calibri")
$Group = GUICtrlCreateGroup("Please complete the fields below.", 25, 40, 593, 420)
GUICtrlSetFont(-1, 9 * _GDIPlus_GraphicsGetDPIRatio(), 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(), 400, 0, "Calibri")
$A001 = GUICtrlCreateInput("", 35, 89, 215, 24)
GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio(), 400, 0, "Calibri")
$B001Label = GUICtrlCreateLabel("Replace Word:", 260, 66, 200, 24)
GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio(), 400, 0, "Calibri")
$B001 = GUICtrlCreateInput("", 260, 89, 180, 24)
GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio(), 400, 0, "Calibri")
$FilenameWextensionLabel = GUICtrlCreateLabel("File name/s with extension", 35, 125, 480, 24)
GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio(), 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(), 400, 0, "Calibri")
GUICtrlSendMsg($FilenameWextension, $EM_LIMITTEXT, -1, 0)
GUICtrlSetFont(-1, 12 * _GDIPlus_GraphicsGetDPIRatio(), 400, 0, "Calibri")
$SubmitLog = GUICtrlCreateButton("Execute", 460, 58, 149, 56, $BS_MULTILINE)
GUICtrlSetFont(-1, 14 * _GDIPlus_GraphicsGetDPIRatio(), 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)
; 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&"_"&@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 - 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 =
_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
Local $aResults = [$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")
$_MACSize = DllStructCreate("int")
DllStructSetData($_MACSize, 1, 6)
$_MACr = DllCall("Ws2_32.dll", "int", "inet_addr", "str", $_MACsIP)
$_MACiIP = $_MACr
$_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
分享一个如何实现excel自带UDF之外的功能，首先开启开发者选项，然后选择录制宏，把自己想要实现的功能操作一遍，停止录制，然后点宏编辑，看一下是用了哪些方法，然后MSDN查资料，最后套用到AU3中。 查找并设置删除线及单元格颜色的代码示例
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进程 学习一下,学习一下. kevinch 发表于 2019-10-23 09:22
查找并设置删除线及单元格颜色的代码示例
大哥好厲害啊 我搞定了, 不過做的時候可以不要打開視窗嗎? 背景讓他執行要怎麼做啊? 謝謝i ipmitool 发表于 2019-10-23 11:21
大哥好厲害啊 我搞定了, 不過做的時候可以不要打開視窗嗎? 背景讓他執行要怎麼做啊? 謝謝i
$oExcel.visible=false kevinch 发表于 2019-10-23 11:40
$oExcel.visible=false
感謝大哥, 全部都解決了, 你好厲害 本帖最后由 ipmitool 于 2019-10-23 14:57 编辑
kevinch 发表于 2019-10-23 09:22
查找并设置删除线及单元格颜色的代码示例
想問一下, 如果要在刪除線的文字後面加文字($123)可以嗎?$123="ABCDEFG"
讓執行出來變成下面這樣, 在同一格內.
long
ABCDEFG
long <- 有刪除線
ABCDEFG <- 沒有刪除線
ipmitool 发表于 2019-10-23 14:56
想問一下, 如果要在刪除線的文字後面加文字($123)可以嗎?$123="ABCDEFG"
讓執行出來變成下面這樣, 在同 ...
先替换单元格内容，再设置删除线 kevinch 发表于 2019-10-23 15:13
先替换单元格内容，再设置删除线
對這個excel處理不太熟, 想請問一下如何替换单元格, 謝謝您... ipmitool 发表于 2019-10-23 16:02
對這個excel處理不太熟, 想請問一下如何替换单元格, 謝謝您...
你想复杂了，单元格读取出来的文本替换好再写回去就行了 kevinch 发表于 2019-10-23 16:09
你想复杂了，单元格读取出来的文本替换好再写回去就行了
大哥, 我有點搞不懂要用甚麼語法? 用 StringReplace這個嗎? 本帖最后由 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进程 感谢两位，学习了！ 这样更好玩
页:
[1]
2