Macro gezocht - Zoek en wis data in sheet1, uit sheet2

[Henk_C_Meerhof]

Hallo Forum,
Ik ben een beginneling wat OO calc betreft, en hopeloos wat programeren betreft.
Ik werk met een Engelstalige versie van OpenOffice vanwege mijn internationale contacten (praat makkelijker als iedereen engels speekt inclusief computers)

Ik heb een oplossing nodig voor het volgende probleem

regelmatig (2 tot 3 keer per maand) moet ik een lijst verwerken waarbij eerst dubbele input gewist moet worden (dit filter heb ik al gevonden) vervolgen moet uit deze geschoonde lijst bepaalde data (black list) gewist worden zodat een bruikbare lijst ontstaat. De waarden in de lijsten zijn tekst strings (stuurcodes).

Mijn eerste ingeving is in een calc-document de nieuwe lijst in sheet1 te inporteren, de 'black list' in sheet2.
Vervolgens de waarde uit het eerste veld van sheet2 te kopieren en deze regel in sheet2 te wissen.
Vervolgens sheet1 te selekteren en een zoek/find uit te voeren op wat uit sheet2 gekopieerd werd.
als de waarde gevonden is, deze regel te selecteren en te wissen, daarna terug naar sheet2
als waarde niet aanwezig is terug naar sheet2

Dit proces te herhalen tot sheet2 leeg is (dus alle waarden van de Black list gewist zijn in sheet1

Klein voorbeeld

De aangeleverde lijst:
a
b
c
d
e

De black list:
a
d

Eindresultaat:
b
c
e

In werkelijkheid zijn de waarden complexe en varierende strings die veel weg hebben van computergegenereerde toegangscodes, er worden alleen a tot z, A tot Z en 0 tot 9 gebruikt, de strings varieren in lengte tussen 6 en ca 50 tekens.


Vervolgens kan de schone lijst van sheet1 verder verwerkt worden door mijn collega's

Als ik dit met de macro recorder probeer te imiteren, krijg ik een macro die alleen de eerste waarde uit sheet2 blijft zoeken, deze macro leest dus niet een nieuwe waarde als voor de tweede keer in sheet 2 gecopieerd wordt.

Wie heeft een oplossing, de basic is abra kadabra voor mij, ik zie wel dat er waardes zijn gelezen, heb geen ideewaar het fout gaat, en nog minder hoe dit te corrigeren.

hier de wat de macro recorder heeft vastgelegt, ik ben er zeker van dat een programmeur dit kan stroomlijnen tot slechts enkele regels.

Code: Selecteer alles

REM  *****  BASIC  *****

Sub Main

End Sub


sub TestBlacklist
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "StringName"
args1(0).Value = "D"

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args1())

rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "Sel"
args2(0).Value = false

dispatcher.executeDispatch(document, ".uno:GoToStartOfRow", "", 0, args2())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "Sel"
args3(0).Value = false

dispatcher.executeDispatch(document, ".uno:GoToStartOfRow", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(1) as new com.sun.star.beans.PropertyValue
args4(0).Name = "By"
args4(0).Value = 1
args4(1).Name = "Sel"
args4(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoUp", "", 0, args4())

rem ----------------------------------------------------------------------
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "ToPoint"
args5(0).Value = "$A$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args5())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, Array())

rem ----------------------------------------------------------------------
dim args8(0) as new com.sun.star.beans.PropertyValue
args8(0).Name = "Nr"
args8(0).Value = 1

dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args8())

rem ----------------------------------------------------------------------
dim args9(17) as new com.sun.star.beans.PropertyValue
args9(0).Name = "SearchItem.StyleFamily"
args9(0).Value = 2
args9(1).Name = "SearchItem.CellType"
args9(1).Value = 0
args9(2).Name = "SearchItem.RowDirection"
args9(2).Value = true
args9(3).Name = "SearchItem.AllTables"
args9(3).Value = false
args9(4).Name = "SearchItem.Backward"
args9(4).Value = false
args9(5).Name = "SearchItem.Pattern"
args9(5).Value = false
args9(6).Name = "SearchItem.Content"
args9(6).Value = false
args9(7).Name = "SearchItem.AsianOptions"
args9(7).Value = false
args9(8).Name = "SearchItem.AlgorithmType"
args9(8).Value = 0
args9(9).Name = "SearchItem.SearchFlags"
args9(9).Value = 65536
args9(10).Name = "SearchItem.SearchString"
args9(10).Value = "A"
args9(11).Name = "SearchItem.ReplaceString"
args9(11).Value = ""
args9(12).Name = "SearchItem.Locale"
args9(12).Value = 255
args9(13).Name = "SearchItem.ChangedChars"
args9(13).Value = 2
args9(14).Name = "SearchItem.DeletedChars"
args9(14).Value = 2
args9(15).Name = "SearchItem.InsertedChars"
args9(15).Value = 2
args9(16).Name = "SearchItem.TransliterateFlags"
args9(16).Value = 1280
args9(17).Name = "SearchItem.Command"
args9(17).Value = 0

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args9())

rem ----------------------------------------------------------------------
dim args10(17) as new com.sun.star.beans.PropertyValue
args10(0).Name = "SearchItem.StyleFamily"
args10(0).Value = 2
args10(1).Name = "SearchItem.CellType"
args10(1).Value = 0
args10(2).Name = "SearchItem.RowDirection"
args10(2).Value = true
args10(3).Name = "SearchItem.AllTables"
args10(3).Value = false
args10(4).Name = "SearchItem.Backward"
args10(4).Value = false
args10(5).Name = "SearchItem.Pattern"
args10(5).Value = false
args10(6).Name = "SearchItem.Content"
args10(6).Value = false
args10(7).Name = "SearchItem.AsianOptions"
args10(7).Value = false
args10(8).Name = "SearchItem.AlgorithmType"
args10(8).Value = 0
args10(9).Name = "SearchItem.SearchFlags"
args10(9).Value = 65536
args10(10).Name = "SearchItem.SearchString"
args10(10).Value = "A"
args10(11).Name = "SearchItem.ReplaceString"
args10(11).Value = ""
args10(12).Name = "SearchItem.Locale"
args10(12).Value = 255
args10(13).Name = "SearchItem.ChangedChars"
args10(13).Value = 2
args10(14).Name = "SearchItem.DeletedChars"
args10(14).Value = 2
args10(15).Name = "SearchItem.InsertedChars"
args10(15).Value = 2
args10(16).Name = "SearchItem.TransliterateFlags"
args10(16).Value = 1280
args10(17).Name = "SearchItem.Command"
args10(17).Value = 0

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args10())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, Array())

rem ----------------------------------------------------------------------
dim args12(0) as new com.sun.star.beans.PropertyValue
args12(0).Name = "Nr"
args12(0).Value = 2

dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args12())


end sub

[RPG]

Hallo

Vergeet voorlopig macros dat geeft geen zicht op het probleem.
Probeer eens te kijken naar een database of met het de mogelijkheid die sorteren biedt.
Met sorteren kun je unique exemplaren laten copieren naar een ander blad
Probeer met een echt voorbeeld te komen

Romke

[RPG]

Hello

Ik heb even gekeken naar sorteren en filteren. Met Filteren kan ik welk unique waarden laten verplaatsen.

Romke

[RPG]

Hallo

Ik heb een klein proefje in de HSQLDB database gedaan en dan is deze code voldoende

Code: Selecteer alles

SELECT
	 DISTINCT
	 "Naam" 
	FROM "ProefBegin" AS "ProefBegin"
	 where 
		"Naam" 
			not in 
		( SELECT * FROM "ProefBlack" AS "ProefBlack")

Romke

[eremmel]

Het zoeken in de blacklist zou je kunnen 'automatiseren' door een extra kolom toe te voegen aan sheet1 en dan met een horizonale lookup te kijken of die regel in de black list staat. Als je dan filtert of sorteerd kun je die 'black-records' eenvoudig verwijderen.
Heb je geen macro's nodig, tenzij dit ook nog te veel handwerk is...

[RPG]

Hallo

Ik vond het idee van Eremmel ook wel interessant om uit te werken. Het vergt enige kennis van OOo-calc om het toe te passen.

Blacklist controle
In de eerste plaats moet de verticaal zoeken opdracht goed toe gepast kunnen worden. Hierbij is het belangrijk om rekening te houden met de vierde parameter. De vierde parameter geeft aan of de tabel waarin gezocht moet worden al of niet een gesorteerde tabel is.
De uitkomst van de verticaal-zoeken opdracht moet men binnen een als opdracht plaatsen. Naar gelang de uitkomst kan er dan een waarde geplaatst worden in de cel waar de zoekopdracht is. Indien eenmaal de zoekopdracht foutloos werkt kan men deze naar beneden kopiëren.

Nu bekend is wat al of niet is toegestaan kan met een pivot tabel een lijst maken van de enkele waarden. Een pivot tabel is wat moeilijk te doorgronden maar met enig klik werk kan men veel ontdekken.

Het gegeven voorbeeld wil niet zeggen dat dit de beste oplossing is maar wil duidelijk maken wat er met de ingebouwde mogelijkheden gedaan kan worden

Romke

[Henk_C_Meerhof]

Hoi Romke en Eremel, Bedankt voor de tips tot nu toe. Ik moet toegeven dat de gebruikt funkties totaal nieuw voor mij zijn, dus dat kost nog tijd om uit te proberen. Ondertussen moest er een gigantisch merge-bestand verstuurd, dat men hier met MS Word niet voor elkaar kreeg (bijlage als PDF enz) dat ging uiteindelijk gesmeerd met OpenOffice. Ik richt mij voorlopig op Eremels tip, omdat hier het meest met Excel/Calc gewerkt wordt.

Henk

[eremmel]

Hoi Henk,

Het voorbeeld van Romke, filtert juist die items die in de black-list voorkomen. Je zou de filter waarde moeten 'negeren' ( 0 <--> 1).
De formule van Romke heeft een verwijzing naar 'Sheet2...', de blacklist. Je zou beter daar een naam definitie van kunnen maken:
Invoegen -> Namen -> Definiëren en dan een naam kiezen:

Voorbeeld blacklist als naam.

blacklist.PNG (9.75 KiB) 6999 keer bekeken

Succes,

Erik