Logo

OpenOffice.orgを利用する上で有益な技術情報を提供していきます。
まずは、calcで重複行(列)を排除するOpenOffice Basic によるマクロを紹介します

行(列)を選択してsOmmitを実行
  

以下ソース
Dim oSheet As Object
Dim oRange As Object
Dim oRangeSelect As Object

Sub sOmitt()
	Dim oCell1     As Object
	Dim oCell2     As Object
    Dim lngIndex   As Long
    Dim lngLoop    As Long
    Dim lngPoint   As Long
    '
    '選択範囲を検索してその重複を削除する
    '
	oSheet = ThisComponent.CurrentController.ActiveSheet 'ActiveSheetを取得
    oRange = ThisComponent.CurrentSelection.getRangeAddress '選択した範囲
    oRangeSelect = ThisComponent.CurrentSelection '選択した範囲

	Dim StartColumn As long
	Dim StartRow      As long
	Dim EndColumn   As long
	Dim EndRow        As long
	StratColumn = 	 oRange.StartColumn
	StratRow      = 	 oRange.StartRow
	EndColumn   = 	 oRange.EndColumn
	EndRow        = 	 oRange.EndRow
	
    Select Case fPublicCheck2

      Case 1
        lngLoop = 	StratRow  '選択範囲の先頭位置
     
        For lngIndex1 = 1 To EndRow
	        oCell1 = oSheet.getCellByPosition(StratColumn , lngLoop)
	        lngPoint = lngLoop + 1 '選択範囲の先頭位置(最初の削除行)
	        
	        For lngIndex2 = lngPoint To EndRow
		      oCell2 = oSheet.getCellByPosition(StratColumn , lngPoint)
	
	          If (oCell1.getString = oCell2.getString) Then
	            oSheet.Rows.removeByIndex(lngPoint, 1) '行の削除
	            EndRow = EndRow - 1
	          Else
	            lngPoint = lngPoint + 1
	          End If
	        Next lngIndex2
	        lngLoop = lngLoop + 1
        Next lngIndex1

		MsgBox "完了しました" , , "GuideTool4OOo"

      Case 2
        lngLoop = 	StratColumn  '選択範囲の先頭位置
     
        For lngIndex1 = 1 To EndColumn
	        oCell1 = oSheet.getCellByPosition(lngLoop , StratRow)
	        lngPoint = lngLoop + 1 '選択範囲の先頭位置(最初の削除列)
	        
	        For lngIndex2 = lngPoint To EndColumn
		      oCell2 = oSheet.getCellByPosition(lngPoint , StratRow)
	
	          If (oCell1.getString = oCell2.getString) Then
	            oSheet.Columns.removeByIndex(lngPoint, 1) '列の削除
	            EndColumn = EndColumn - 1
	          Else
	            lngPoint = lngPoint + 1
	          End If
	        Next lngIndex2
	        lngLoop = lngLoop + 1
        Next lngIndex1

		MsgBox "完了しました" , , "GuideTool4OOo"
    End Select
    
    Set oRange = Nothing
    Set oRangeSelect = Nothing
    Set oSheet = Nothing

End Sub

Function fPublicCheck2() As Integer
    '
    '共通チェック2 選択範囲チェック
    '
    fPublicCheck2 = 0 'error
    If (oRangeSelect.Columns.Count > 1) And (oRangeSelect.Rows.Count > 1) Then
      MsgBox "単一の列又は行を選択して実行して下さい", , "GuideTool4OOo"
      Exit Function
    End If
    If (oRangeSelect.Columns.Count = 1) And (oRangeSelect.Rows.Count = 1) Then
      MsgBox "複数行又は複数列を選択して実行して下さい", ,"GuideTool4OOo"
      Exit Function
    End If
    If (oRangeSelect.Columns.Count = 1) Then '行検索
      fPublicCheck2 = 1 'Line Search
    Else
      fPublicCheck2 = 2 'Column Search
    End If
ExitHere:
    Exit Function
End Function

この Webサイトに関する質問やコメントについては、 webmaster@ngs.co.jp まで電子メールをお送りください。

(C)2006 Nippon Guide System Corporation.All rights reserved.