Excel vba 檢查儲存格中的值是否在其它資料表中出現並標記

參考:

如何在 Excel 中計算範圍內之數字或文字出現的次數

用Range?用Cells?

說明:檢查儲存格的值,是否在其它表格範圍(range)出現(countif)。

VBA CODE

'將要檢查的工作表Sheet1 (DATA) 儲存格E26~E112中的值, 一個一個取出來用來統計是否在工作表Sheet3 (Sheet1)
'儲存格中F2~F303 是否有出現過。
'如果有出現過,就將受檢查的儲存格的內容文件改為紅色字。

Function usecells()
Dim j As Long
'僅在 Sheet1 中執行以下程式碼
With Sheet1
For j = 26 To 112
    cas = .Range("E" & j) '取得受檢查字串
    '判斷字串在樣本中是否出現
    If Application.WorksheetFunction.CountIf(Workbooks(1).Sheets(3).Range("f2:f303"), "*" & cas & "*") > 0 Then
        .Range("E" & j).Font.ColorIndex = 3 '修改字體顏色為紅色
    End If
Next
End With
End Function
廣告

[轉貼] Excel VBA – 從 Word 表格取回資料

出至:http://www.pczone.com.tw/vbb3/thread/5/61970/

【教學】Excel VBA – 從 Word 表格取回資料

如何從Word表格取回資料至Excel工作表?
我所知的方法有 DDE 和 OLE,但我只會用 OLE 囉…

Sub get_word_table( )
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open("D:\Temp\ole_test.doc")
With wrdDoc.Tables(1)
 For r = 1 To .Rows.Count
  For c = 1 To .Columns.Count
  Cells(r, c) = .Cell(r, c)
  Next c
 Next r
End With
wrdDoc.Close ‘close the document
wrdApp.Quit ‘close Word
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub

逐行說明

宣告一個物件變數 wrdApp
令物件變數 wrdApp = 建立的Word應用程式物件
令物件變數 wrdDoc = 指定的Word文件檔案
引用該 Word 文件的第一個表格
對該表格的每一列做迴圈, 變數 r 為列號
對每一列的每一欄做迴圈, 變數 c 為欄號
令目前工作表的第 r 列第 c 欄儲存格值 = 該 Word 表格的對應儲存格
繼續迴圈中的下一欄, 直到最後一欄
繼續迴圈中的下一列, 直到最後一列
結束該Word表格的引用
關閉該Word文件檔
結束Word應用程式
釋放物件變數wrdDoc
釋放物件變數wrdApp

PS.這個程式要在Excel空白工作表中執行。

Excel 檔案異常大 2007(xlsx) 存成2003(xls)

Excel xlsx 另存 xls 檔案異常的大

最有可能的原因可能是該檔案是由office2007以上的版本所建立的。但為了讓office2003可以讀取該檔,所以將它另存為xls(2003版本的檔案),但新版有許多新功能或樣式,然而舊版卻沒有。所以另存時會有一堆看不見的物件加到舊版格式的檔案中。因此新版檔案(xlsx)另存舊版檔案類型(xls)就變大很多很多。

解決辦法:利用 libreoffice 讀取被另存舊版的檔案,再做一次另存新檔的動作。但不變更目前的檔案格式。

libreoffice (xls) -> 另存 (xls) 檔案回復正常。

 

VBA 巨集取出 Excel 中的圖檔

出至:VBA – Extract Pictures from Excel

Last month, I have written Excel Automation Using VBScript. Today this post is to extract Pictures from Excel. Generally We can not use Export method for pictures. But we can use for Excel charts. I tried to extract our SVG chart image by macro and I succeed on it. I got help from Export pictures from Excel Below I’ve given the VBA Macro code.

Sub GetFirstPicture()

Dim sCurrPath As String
Dim aWorkSheet As Excel.Worksheet
Dim aShape As Excel.Shape
Dim aShapeChart As Excel.Shape
Dim aPicture As Variant
Dim aChart As Excel.Chart
Dim sCurrentSheet As String

Dim aImage As Variant
Dim iIndex As Integer
Dim iShapeCount As Integer

Dim MyChart As String, MyPicture As String
Dim PicWidth As Long, PicHeight As Long
Dim sChartJpg As String
Dim sChartGif As String
Dim sChartBmp As String

‘On Error GoTo ErrHandler
On Error Resume Next

Application.ScreenUpdating = False

sCurrPath = “D:\VB\MyTrials\ChartExpFromXL"
sChartJpg = “D:\VB\MyTrials\ChartExpFromXL.jpg"
sChartGif = “D:\VB\MyTrials\ChartExpFromXL.gif"
sChartBmp = “D:\VB\MyTrials\ChartExpFromXL.bmp"

Set aWorkSheet = ActiveWorkbook.ActiveSheet
sCurrentSheet = aWorkSheet.Name

‘MsgBox CStr(msoTrue) + " value for MsoTrue"
‘ MsoTrue equals to -1
MsgBox “Shapes count " + CStr(aWorkSheet.Shapes.Count)
For iIndex = 1 To aWorkSheet.Shapes.Count

Set aShape = aWorkSheet.Shapes(iIndex)
MyPicture = aShape.Name
MsgBox aShape.Name + " Name, " + Str(aShape.Type)
‘Picture 1 Name, 13
If Left(aShape.Name, 7) = “Picture" Then
With aShape
PicHeight = .Height
PicWidth = .Width
End With
‘Set aChart = aWorkSheet.ChartObjects(1)
Set aChart = ActiveWorkbook.Charts.Add
ActiveWorkbook.ActiveChart.Location Where:=xlLocationAsObject, Name:=sCurrentSheet
iShapeCount = aWorkSheet.Shapes.Count
Set aShapeChart = aWorkSheet.Shapes(iShapeCount)
MyChart = aShapeChart.Name ‘"Chart " & Str(aWorkSheet.Shapes.Count)

aShapeChart.Width = PicWidth
aShapeChart.Height = PicHeight

With aWorkSheet
aShape.Copy

With ActiveChart ‘aChart
.ChartArea.Select
.Paste
End With

.ChartObjects(1).Chart.Export Filename:=sChartJpg, FilterName:="jpg", Interactive:=True
.ChartObjects(1).Chart.Export Filename:=sChartGif
.ChartObjects(1).Chart.Export Filename:=sCurrPath & “.png"
‘Not working .ChartObjects(1).Chart.Export Filename:=sChartBmp, FilterName:="bmp"
aShapeChart.Cut
End With

Application.ScreenUpdating = True

MsgBox “Completed."
Exit Sub

End If

Next

MsgBox “Completed."
Exit Sub

ErrHandler:
MsgBox “Error # " & CStr(Err.Number) & " " & Err.Description & " " & Err.Source
Err.Clear ‘ Clear the error.
End Sub

Extract Images from an Excel Document

出至:http://stackoverflow.com/questions/5503015/extract-images-from-an-excel-document

First, use unoconv to convert the .xls to .pdf:

http://dag.wieers.com/home-made/unoconv/

On Ubuntu 10.10 command line:

sudo apt-get install unoconv
unoconv -f pdf file.xls
Then extract the images from the pdf using pdfimages (which seems to come bundled with Ubuntu):

http://en.wikipedia.org/wiki/Pdfimages

Back on the command line:

pdfimages file.pdf fileimage
And done! All of the images in the .xls are now in separate files in the directory. This could be done very easily on most Linux systems using your language of choice. In python, for example:

import subprocess
subprocess.call([‘unoconv’,’-f’,’pdf’,’file.xls’])
subprocess.call([‘pdfimages’,’file.pdf’,’fileimage’])

I would love to hear a simpler solution if somebody has one.
******************************************************************************************

If a excel file is a compressed file.(xlsx)

$ unzip file.xlsx

in xl/media/ are all pictures

Python Excel Mini Cookbook

From: Python Excel Mini Cookbook

Python Excel Mini Cookbook
Posted on October 5, 2009
To get you started, I’ve illustrated a number of common tasks you can do with Python and Excel. Each program below is a self contained example, just copy it, paste it and run it. A few things to note:

These examples were tested in Excel 2007, they should work fine in earlier versions as well after changing the extension of the file within the wb.SaveAs() statement from .xlsx to .xls
If you’re new to this, I recommend typing these examples by hand into IDLE, IPython or the Python interpreter, then watching the effect in Excel as you enter the commands. To make Excel visible add the line excel.Visible = True after the excel =win32.gencache.EnsureDispatch(‘Excel.Application’) line in the script
These are simple examples with no error checking. Make sure the output files doesn’t exist before running the script. If the script crashes, it may leave a copy of Excel running in the background. Open the Windows Task Manager and kill the background Excel process to recover.
These examples contain no optimization. You typically wouldn’t use a for loop to iterate through data in individual cells, it’s provided here for illustration only.
Open Excel, Add a Workbook

The following script simply invokes Excel, adds a workbook and saves the empty workbook.

#
# Add a workbook and save (Excel 2007)
# For older versions of excel, use the .xls file extension
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
wb.SaveAs(‘add_a_workbook.xlsx’)
excel.Application.Quit()
Open an Existing Workbook

This script opens an existing workbook and displays it (note the statement excel.Visible =True). The file workbook1.xlsx must already exist in your “My Documents” directory. You can also open spreadsheet files by specifying the full path to the file as shown below. Using r’in the statement r’C:\myfiles\excel\workbook2.xlsx’ automatically escapes the backslash characters and makes the file name a bit more concise.

#
# Open an existing workbook
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Open(‘workbook1.xlsx’)
# Alternately, specify the full path to the workbook
# wb = excel.Workbooks.Open(r’C:\myfiles\excel\workbook2.xlsx’)
excel.Visible = True
Add a Worksheet

This script creates a new workbook with three sheets, adds a fourth worksheet and names it MyNewSheet.

#
# Add a workbook, add a worksheet,
# name it ‘MyNewSheet’ and save
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
ws = wb.Worksheets.Add()
ws.Name = “MyNewSheet"
wb.SaveAs(‘add_a_worksheet.xlsx’)
excel.Application.Quit()
Ranges and Offsets

This script illustrates different techniques for addressing cells by using the Cells() and Range()operators. Individual cells can be addressed using Cells(row,column), where row is the row number, column is the column number, both start from 1. Groups of cells can be addressed using Range(), where the argument in the parenthesis can be a single cell denoted by its textual name (eg “A2″), a group noted by a textual name with a colon (eg “A3:B4″) or a group denoted with two Cells() identifiers (eg ws.Cells(1,1),ws.Cells(2,2)). The Offsetmethod provides a way to address a cell based on a reference to another cell.

#
# Using ranges and offsets
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
ws = wb.Worksheets(“Sheet1″)
ws.Cells(1,1).Value = “Cell A1″
ws.Cells(1,1).Offset(2,4).Value = “Cell D2″
ws.Range(“A2″).Value = “Cell A2″
ws.Range(“A3:B4″).Value = “A3:B4″
ws.Range(“A6:B7,A9:B10″).Value = “A6:B7,A9:B10″
wb.SaveAs(‘ranges_and_offsets.xlsx’)
excel.Application.Quit()
Autofill Cell Contents

This script uses Excel’s autofill capability to examine data in cells A1 and A2, then autofill the remaining column of cells through A10.

#
# Autofill cell contents
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
ws = wb.Worksheets(“Sheet1″)
ws.Range(“A1″).Value = 1
ws.Range(“A2″).Value = 2
ws.Range(“A1:A2″).AutoFill(ws.Range(“A1:A10″),win32.constants.xlFillDefault)
wb.SaveAs(‘autofill_cells.xlsx’)
excel.Application.Quit()
Cell Color

This script illustrates adding an interior color to the cell using Interior.ColorIndex. Column A, rows 1 through 20 are filled with a number and assigned that ColorIndex.

#
# Add an interior color to cells
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
ws = wb.Worksheets(“Sheet1″)
for i in range (1,21):
ws.Cells(i,1).Value = i
ws.Cells(i,1).Interior.ColorIndex = i
wb.SaveAs(‘cell_color.xlsx’)
excel.Application.Quit()
Column Formatting

This script creates two columns of data, one narrow and one wide, then formats the column width with the ColumnWidth property. You can also use the Columns.AutoFit() function to autofit all columns in the spreadsheet.

#
# Set column widths
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
ws = wb.Worksheets(“Sheet1″)
ws.Range(“A1:A10″).Value = “A"
ws.Range(“B1:B10″).Value = “This is a very long line of text"
ws.Columns(1).ColumnWidth = 1
ws.Range(“B:B").ColumnWidth = 27
# Alternately, you can autofit all columns in the worksheet
# ws.Columns.AutoFit()
wb.SaveAs(‘column_widths.xlsx’)
excel.Application.Quit()
Copying Data from Worksheet to Worksheet

This script uses the FillAcrossSheets() method to copy data from one location to all other worksheets in the workbook. Specifically, the data in the range A1:J10 is copied from Sheet1 to sheets Sheet2 and Sheet3.

#
# Copy data and formatting from a range of one worksheet
# to all other worksheets in a workbook
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
ws = wb.Worksheets(“Sheet1″)
ws.Range(“A1:J10″).Formula = “=row()*column()"
wb.Worksheets.FillAcrossSheets(wb.Worksheets(“Sheet1″).Range(“A1:J10″))
wb.SaveAs(‘copy_worksheet_to_worksheet.xlsx’)
excel.Application.Quit()
Format Worksheet Cells

This script creates two columns of data, then formats the font type and font size used in the worksheet. Five different fonts and sizes are used, the numbers are formatted using a monetary format.

#
# Format cell font name and size, format numbers in monetary format
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
ws = wb.Worksheets(“Sheet1″)

for i,font in enumerate([“Arial","Courier New","Garamond","Georgia","Verdana"]):
ws.Range(ws.Cells(i+1,1),ws.Cells(i+1,2)).Value = [font,i+i]
ws.Range(ws.Cells(i+1,1),ws.Cells(i+1,2)).Font.Name = font
ws.Range(ws.Cells(i+1,1),ws.Cells(i+1,2)).Font.Size = 12+i

ws.Range(“A1:A5″).HorizontalAlignment = win32.constants.xlRight
ws.Range(“B1:B5″).NumberFormat = “$###,##0.00″
ws.Columns.AutoFit()
wb.SaveAs(‘format_cells.xlsx’)
excel.Application.Quit()
Setting Row Height

This script illustrates row height. Similar to column height, row height can be set with the RowHeight method. You can also useAutoFit() to automatically adjust the row height based on cell contents.

#
# Set row heights and align text within the cell
#
import win32com.client as win32
excel = win32.gencache.EnsureDispatch(‘Excel.Application’)
wb = excel.Workbooks.Add()
ws = wb.Worksheets(“Sheet1″)
ws.Range(“A1:A2″).Value = “1 line"
ws.Range(“B1:B2″).Value = “Two\nlines"
ws.Range(“C1:C2″).Value = “Three\nlines\nhere"
ws.Range(“D1:D2″).Value = “This\nis\nfour\nlines"
ws.Rows(1).RowHeight = 60
ws.Range(“2:2″).RowHeight = 120
ws.Rows(1).VerticalAlignment = win32.constants.xlCenter
ws.Range(“2:2″).VerticalAlignment = win32.constants.xlCenter

# Alternately, you can autofit all rows in the worksheet
# ws.Rows.AutoFit()

wb.SaveAs(‘row_height.xlsx’)
excel.Application.Quit()

 

Prerequisites

Python (refer to http://www.python.org)

Win32 Python module (refer to http://sourceforge.net/projects/pywin32)

Microsoft Excel (refer to http://office.microsoft.com/excel)

Source Files and Scripts

Source for the program and data text file are available athttp://github.com/pythonexcels/examples

That’s all for now, thanks — Dan