特定列のセルの値を一意にする - Unique a Value of Cells of a Specific Column

はじめに - Introduction

特定列のセルの値を一意にしたい！
I'd like to unique a value of cells of a specific column!

それは Excel や Google Docs の表計算ソフトの UNIQUE関数で実現できます。
It can be realized by UNIQUE function of table calculation soft such as Excel and Google Docs.

しかし、StarSuite Calc（OpenOffice Calc）には実現方法が無かったのでマクロを書きました。
But there is no method to do it by using StarSuite Basic (OpenOffice Calc) so I wrote a macro.

ソースコード - Source code

Dim objDocument As Object
Dim objSheet As Object
Const INPUT_COLUMN As Integer = 0 ' A column
Const OUTPUT_COLUMN As Integer = 1 ' B column

' ===== Usage =====
' Prepare sheet named "target".
' Paste elements on A column which you'd like to unique.
' Execute this macro, then uniqued elements shown on B column.
Public Sub Unique
	objDocument = ThisComponent
	objSheet = objDocument.Sheets.getByName("target")
	
	Dim intRow As Integer
	Dim objCell As Object
	Dim inputElements() As String
	
	' Extract input elements.
	intRow = 0
	Do Until objSheet.getCellByPosition(INPUT_COLUMN, intRow).String = ""
		ReDim Preserve inputElements(intRow + 1)
		inputElements(intRow) = objSheet.getCellByPosition(INPUT_COLUMN, intRow).String
		intRow = intRow + 1
	Loop

	' Unique elements.
	Dim aryUniquedElements(1) As String
	Dim strTargetElement As String
	Dim intInputRow As Integer
	Dim intUniquedRow As Integer
	intInputRow = 0
	intUniquedRow = 0
	Do Until inputElements(intInputRow) = ""
		strTargetElement = inputElements(intInputRow)
		
		' Whether already regarded as unique or not.
		Dim blnRegisteredAsUnique As Boolean		
		Dim intFindRow As Integer
		intFindRow = 0
		blnRegisteredAsUnique = False
		Do Until aryUniquedElements(intFindRow) = ""
			If (aryUniquedElements(intFindRow) = strTargetElement) Then
				blnRegisteredAsUnique = True
			End If
			
			intFindRow = intFindRow + 1
		Loop

		' If never uniqued, then it regarded as unique.
		If Not blnRegisteredAsUnique Then
			ReDim Preserve aryUniquedElements(intUniquedRow + 1)
			aryUniquedElements(intUniquedRow) = strTargetElement
			intUniquedRow = intUniquedRow + 1
		End If
		
		intInputRow = intInputRow + 1
	Loop

	' Output uniqued elements.
	intUniquedRow = 0
	Do Until aryUniquedElements(intUniquedRow) = ""
		objSheet.getCellByPosition(OUTPUT_COLUMN, intUniquedRow).String = aryUniquedElements(intUniquedRow)
		intUniquedRow = intUniquedRow + 1
	Loop
End Sub

使い方 - Usage

実行前 - Before execution

一意にしたい値をA列に貼り付けておきます。
Put a values, which you'd like to unique, on A column.

シート名は「target」にします。
Change sheet name as "target".

実行 - Execution

以下の手順は StarSuite Basic でマクロを実行する方法です。OpenOffice でも同じように実行できます。
The following steps are how to execute this macro by StarSuite Basic. You can do it by OpenOffice too.

ツール＞マクロ＞マクロの管理＞ StarSuite Basic
マイマクロ＞ Module1 ＞編集
上記のソースコードをコピペして閉じる
ツール＞マクロ＞マクロを実行
マイマクロ＞ Standard ＞ Module1 ＞ Unique を実行

実行後 - After execution

一意になった要素はB列に出力されます！
Now you can see uniqed values are outputted to B column!

※実行は自己責任でお願いします - Take full responsibility for your execution

参考文献 - References

StarSuite 8 Basic プログラミングガイド - Sun Microsystems

−ω−

bekkou68 の日記

Gogengo! や IT 技術など。