Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Mit Excel VBA Zeilen nach Bestimmten Kriterien einfügen

Frage Entwicklung VB for Applications

Mitglied: PascalS

PascalS (Level 1) - Jetzt verbinden

13.08.2007, aktualisiert 20.08.2007, 20390 Aufrufe, 8 Kommentare

Hallo zusammen,

bin zur Zeit daran, verschiedene Listen in Excel miteinander abzugleichen.
Dazu habe ich die Listen zunächst aus einer Textdatei eingelesen.
Es handelt sich um eine immer wiederkehrende Abfolge, die jedoch fast nie identisch ist.

Bsp.:
Wert 1
Wert 5
Wert 8
Wert 27


Diese Liste soll mit einer Musterliste abgeglichen werden, die alle denkbaren Werte enthält.


Muster:
Wert 1
Wert 2
Wert 3
Wert 4
usw.


nun habe ich mir überlegt, jede Zelle der Liste zu prüfen und eine Zeile einzufügen, wenn erin Wert fehlt, der in der Musterliste auftaucht.
Hat jemand eine Idee, wie ich das angehen könnte?

Laut Musterliste sind pro Datensatz 60 Zeilen vorgesehen. In der Liste zum Abgleich sind 740 Datensätze enthalten.

Vielleicht kann man ja den Abgleich für einen Datensatz machen und dann einfach nach unten kopieren?

Vielen Dank im Voraus

Viele Grüße
Pascal
Mitglied: SvenGuenter
13.08.2007 um 14:27 Uhr
Brauchst du dafür acuh den Quellcode?

Prinzipiell geht es folgendermaßen

deine referenzliste in ein Array

nun ersten wert von arry in variable mit ersten wert liste vergleichen wenn diese sortiert ist. Wenn gleich zweiten wert arry zweiten wert liste. Wenn nicht gleich Zelle einfügen dann WErt aus array einfügen

Wenn du den kompletten Quellcode brauchst kann ich das eben schreiben ansonsten gebe ich dir den Pseudocode der müßte eigentlich reichen

hier mal ein Beispiel
Sub dateilesen()
'Diese Sub kann dazu genutzt werden einen String der eingelesen wird zu ergänzen oder anderweitig zu
'manipulieren. Ebenfalls wird der String bzw alle Streings aus allen vorhandenen Textfiles in eine
'Datei geschrieben
'erstellt am 23.05.2007
'Autor: Sven Günter



'Konstanten die FileSystemObject Objekte besser lesbar zu machen
Const ForReading = 1, ForWriting = 2, ForAppending = 8


'Definition der benötigten internen Variablen
Dim abgleich
Dim speicher
Dim fs, a, retstring, b
Dim ML
'Erzeugen des FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject")
ML = "24"
'Erzeugen der Zieldatei
'fs.CreateTextFile "c:\gesamtneu.txt"
'Zuweisung der Quelldatei
Set a = fs.opentextfile("C:\xxx\yyyyyy.txt", ForReading, False)
'Zuweisen der Zieldatei
Set b = fs.opentextfile("C:\gesamtneu.txt", ForAppending, True)

'2-24 ohne 12

'Schleife bis das Ende der Quelldatei erreicht ist
Do While a.AtEndOfStream <> True
'Einlesen der 1. zeile
retstring = a.readline
'Erzeugen eines Arrays welches die einzelnen Werte aufnimmt
abgleich = Split(retstring, vbTab, -1)
'MsgBox (retstring)
speicher = 1
'Wenn Bedingung.
If Not retstring = "" And Not speicher = 0 Then

If IsNumeric(abgleich(0)) Then
'Wenn das erste Feld numerisch ist hier die BKN dann wird der komplette satz weggeschrieben
retstring = ML + vbTab + retstring
b.writeline retstring
abgleich = Split(retstring, vbTab, -1)
speicher = abgleich(1)

Do While a.AtEndOfStream <> True And speicher = abgleich(1)

retstring = a.readline
abgleich = Split(retstring, vbTab, -1)

If Not retstring = "" Then

If abgleich(0) = "" Then
'Hier wird der String aufgefüllt mit der BKN die im Merker Speicher steht
retstring = ML + vbTab + speicher + retstring
b.writeline retstring
End If

Else
GoTo naechster

End If


abgleich = Split(retstring, vbTab, -1)


Loop
naechster:
End If
End If

Loop
a.Close
b.Close
End Sub

Dabei wird aber alles aus der Textdatei gelesen und auch wieder in eine textdatei weggeschrieben.

Um Zellen in Excel zu manipulieren machst du folgendes

Sub MuZ()
'Deklaration der Variablen
Dim a As Integer
Dim b As Integer
'Variablen mit Startwert vorbelegen
a = 1
b = 1
'Schleife für das Zeilenweite vorgehen
While Not IsEmpty(Cells(a, b))


If IsNumeric(Cells(a, b)) Then
b = 2
'Schleife für das Reihenweise vorgehen
While Not IsEmpty(Cells(a, b))
'Umformatieren der Zelle
Format (Cells(a, b).NumberFormat = "##,##0.00")
Cells(a, b) = Cells(a, b) * 1

b = b + 1
Wend

End If

b = 1
a = a + 1
Wend

End Sub

in der while schleife kannst du machen was du willst neue zeilen einfügen oder oder oder



Hoffe ich konnte Dir helfen

Gruß

Sven



Das problem bei dir ist das du einen Gruppenwechsel hast wie in meinem ersten Beispiel und du dir die Gruppenmerkamle merken musst und diese abgleichen musst.
Bitte warten ..
Mitglied: PascalS
13.08.2007 um 15:52 Uhr
Hi Sven,

das hilft mir schon weiter. Jedenfalls weiss ich jetzt, dass es eine Lösung gibt

Allerdings bin ich in VBA noch nicht so fit.
Könntest Du mit bei dem Code vielleicht etwas auf die Sprümnge helfen?

Wäre echt super.

Viele Grüße

Pascal
Bitte warten ..
Mitglied: SvenGuenter
13.08.2007 um 15:56 Uhr
Kein Problem. Ich muss gleich in ein Meeting und dann mache ich mich auf den Heimweg. Werde dir nachher von zuhause den kompletten Code posten. Nur nochmal zur Info

Du hast eine Referenztabelle in der alle Werte stehen.
Dann hast du abzugleichende Tabellen in denen nicht alle Werte stehen aber nachher alle werte drinstehen sollen. Sehe das so richtig?


Gruß

Sven
Bitte warten ..
Mitglied: PascalS
13.08.2007 um 16:05 Uhr
Hio Sven, das ist ja echt supernett.

Ja richtig, es liegt eine Referenztabelle mit ca 60 Zeilen vor.
Die abzugleichenden Tabellen sind nicht vollständig. Es fehlen auch immer andere Positionen.


Dabei ist es nicht zwingend erforderlich, dass Werte darin stehen. Es wäre nur gut, wenn später die fehlenden Positionen zumindest durch Leerzeilen aufgefüllt wären.

Später sollen die Werte, die sich darin befinden dann gegengerechnet werden um die Richtigkeit zu prüfen.

Als Vorabinformation:

1.Es handelt sich um eine importierte Textdatei.

2.Zum diesem Zeitpunkt ist noch keine Spaltentrennung erfolgt --> also eigentlich nur eine
Spalte relevant.

3. Problematisch könnte sein, dass auf der rechten Seite, der Zellen immer individuelle
Zahlenwerte stehen. Vielleicht ist es daher möglich nur die übereinstiummenden Texte zu
prüfen und ggf eine Leerzeile einzufügen

Viele Grüße

Pascal
Bitte warten ..
Mitglied: SvenGuenter
14.08.2007 um 07:52 Uhr
hi Pascal sicher ist es das. Das macht man mit einer Prüfroutine. Gib mir doch bitte noch einen Datensatz wie der in der Textdatei aussieht.
Ein Datensatz bei mir in der Datei sieht wie folgt aus

1;Textbeispiel;123,45€
2;Textbeispiel;234,56€
Bitte warten ..
Mitglied: SvenGuenter
14.08.2007 um 08:29 Uhr
Hier schonmal vorab der Quellcode.

Option Explicit
'Globale Variablen brauchen wir nachher
Dim zeile As Integer
Dim Spalte As Integer

Private Sub einlesen()

' Hier sind konstanten vorgegeben die brauchen wir fürs FileSystemObject
Const ForReading = 1, ForWriting = 2, ForAppending = 8


'Definition der benötigten internen Variablen


Dim abgleich
Dim speicher
Dim fs, a, retstring
zeile = 1
Spalte = 1

'Erzeugen des FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject")

Erzeugen des Objectes fürs einlesen der Strings aus dem Textfile
Set a = fs.opentextfile("C:\test\test.txt", ForReading, False)


'Schleife bis das Ende der Quelldatei erreicht ist
Do While a.AtEndOfStream <> True
'Einlesen der 1. zeile
retstring = a.readline
'Erzeugen eines Arrays welches die einzelnen Werte aufnimmt. Hier kann man als Delemiter
' auch tabs oder andere Trennzeichen nehmen. Ich habe in meinem Textfile halt ein Semikolon
'genommen
abgleich = Split(retstring, ";", -1)
'MsgBox (retstring)'Dies ist nur zum Testen gewesen
speicher = 1
'Wenn Bedingung.
'Prüfen ob ein Leerstring übergeben wurde
If Not retstring = "" And Not speicher = 0 Then

'Prüfen ob der erste Teil eine Zahl ist. Hatte das so verstanden das als erstes immer eine
'Zahl ist. Also ein Wert. Wenn dem nicht so ist einfach mit dem abgleichen was da stehen
'sollte
If IsNumeric(abgleich(0)) Then

abgleich = Split(retstring, ";", -1)
speicher = abgleich(1)
'einfuegen in Excel indem die Funktion einfuegen aufgerufen wird. Hier wird der komplette
'String übergeben. Man kann aber auch mehrere Werte übergeben.
einfuegen (retstring)


Else
einfuegen ("Kein Eintrag" + retstring)
End If
End If

Loop
a.Close

End Sub

'Funktion zum einfuegen der einzelnen Werte in Excel.
Private Sub einfuegen(uebergabe)

Cells(zeile, Spalte) = uebergabe
zeile = zeile + 1

End Sub

Das ist das grobe konzept. Wenn du noch Probleme hast kannst du dich auch per mail an mich wenden unter
Sven.Guenter@Sven-Guenter.com
Bitte warten ..
Mitglied: SvenGuenter
20.08.2007 um 09:38 Uhr
Option Explicit
Dim zeile As Long
Dim Spalte As Long
Dim zeileerg As Long
Dim spalteerg As Long
Dim zeileref As Long
Dim i As Integer




Private Sub einlesen()

i = 3

'Definition der benötigten internen Variablen
spalteerg = 1
zeileerg = 1
Dim gesamtzaehler As Long
Dim abgleich As String
Dim kundennummer As String
Dim zeilenmerker As Long


Dim speicher, speicher1, speicher2
Dim fs, a, retstring, b
Dim ML
zeile = 1
zeileref = 1
zeileerg = 1

kundennummer = Tabelle1.Cells(zeile, 1)

'Schleife bis das Ende der Quelldatei erreicht ist
Do While Not Tabelle1.Cells(zeile, 1) = ""
'Einlesen der 1. zeile
SprungmarkeNeueKundennummer:

If CStr(Tabelle1.Cells(zeile, 1)) = CStr(kundennummer) Then
'MsgBox (Tabelle2.Cells(zeile, Spalte))
Do While Not Tabelle2.Cells(zeileref, 1) = ""
If pruefen(Tabelle1.Cells(zeile, 2)) = 1 Then

zeilenanzahlpruefen (zeileerg)
Sheets(i).Cells(zeileerg, 2) = Tabelle1.Cells(zeile, 2)
Sheets(i).Cells(zeileerg, 1) = Tabelle1.Cells(zeile, 1)

zeileerg = zeileerg + 1
zeileref = zeileref + 1
zeile = zeile + 1
If CStr(Tabelle1.Cells(zeile, 1)) = CStr(kundennummer) Then
GoTo sprung2
Else
zeile = zeile - 1
End If



Else
zeilenanzahlpruefen (zeileerg)
Sheets(i).Cells(zeileerg, 2) = Tabelle2.Cells(zeileref, 1) & "Kein Eintrag"
Sheets(i).Cells(zeileerg, 1) = kundennummer & "Kein Eintrag"
zeileref = zeileref + 1
zeileerg = zeileerg + 1

End If


sprung2:

Loop
zeile = zeile + 1
kundennummer = Tabelle1.Cells(zeile, 1)
zeilenanzahlpruefen (zeileerg)
zeileref = 1


Else
zeileref = 1

kundennummer = Tabelle1.Cells(zeile, 1)
GoTo SprungmarkeNeueKundennummer
End If
Loop
End Sub


Private Function zeilenanzahlpruefen(uebergabe As Long)
If zeileerg > 60000 Then


'Hier die Möglichkeit alles Dynamisch zu machen und ein Sheet einzufügen wenn ein neues 'benötigt wird. Habe ihc erstmal weggelassen.
'ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)


zeileerg = 1
spalteerg = 1
'i ist die Sheet nummer. Ich weiß ich bin Faul udn es ist nicht sprechend.
i = i + 1

End If


End Function


Private Function pruefen(uebergabe As String) As Integer

If Not CStr(uebergabe) = "" And CStr(uebergabe) = CStr(Tabelle2.Cells(zeileref, 1)) Then

pruefen = 1

Else
pruefen = 0
End If



End Function
Bitte warten ..
Mitglied: PascalS
20.08.2007 um 09:40 Uhr
Hallo Sven,

vielen Dank, das war die richtige Lösung!

Viele Grüße
Pascal
Bitte warten ..
Ähnliche Inhalte
VB for Applications
Excel VBA Formel "WENN" einfügen
gelöst Frage von chef1568VB for Applications2 Kommentare

Hallo zusammen, ich möchte per Excel-Makro folgende Formel eintragen: EXCEL: VBA: Leider bekomme ich hier immer einen anwendungsrelevanten Fehler ...

Microsoft Office
Excel mit VBA: Bild aus dem Internet einfügen
gelöst Frage von peterhaMicrosoft Office2 Kommentare

Hallo zusammen, ich habe gestern etliche vba-Schnipsel ausprobiert, aber keines hat so richtig hingehauen Ich möchte: Ein Bild aus ...

Microsoft Office
Zeilen in Excel einfügen wenn eine Bedingung erfüllt ist
gelöst Frage von geosulfMicrosoft Office8 Kommentare

Hallo ich möchte ein Problem in Excel lösen habe ein zwei Tägiges Seminar Excel VBA Einsteiger besucht und nun ...

Microsoft Office
VBA: nach ausgewählten Kriterien filtern
Frage von BerndVorwerkMicrosoft Office7 Kommentare

Hallo an alle. Auch auf die Gefahr hin, dass ich euch so langsam auf die Nerven gehe, aber ich ...

Neue Wissensbeiträge
Internet

Was nützt HTTPS, wenn es auch von Phishing Web-Seiten genutzt wird

Information von Penny.Cilin vor 2 TagenInternet17 Kommentare

HTTPS richtig einschätzen Ob man eine Webseite via HTTPS aufruft, zeigt ein Schloss neben der Adresse im Webbrowser an. ...

Webbrowser

Bugfix für Firefox Quantum released - Installation erfolgt teilweise nicht automatisch!

Erfahrungsbericht von Volchy vor 4 TagenWebbrowser8 Kommentare

Hallo zusammen, gem. dem Artike von heise online wurde mit VersionFirefox 57.0.1 sicherheitsrelevante Bugs behoben. Entgegen der aktuellen Veröffentlichung ...

Sicherheit

Teamviewer Sessions können gekapert werden - Update tw. verfügbar

Information von sabines vor 4 TagenSicherheit6 Kommentare

In bestimmten Konstellationen können Teamviewer Sessions gekapert werden, wahrscheinlich aber ein recht unwahrscheinliches Szenario. Da der Teamviewer gerne für ...

Digitiales Fernsehen

Apple TV: Amazon Prime App ist verfügbar

Information von Frank vor 4 TagenDigitiales Fernsehen4 Kommentare

Die Amazon Prime Video App kann ab sofort auf einem Apple TV ab der 3 Generation installiert werden. Einfach ...

Heiß diskutierte Inhalte
Vmware
Installation Windows 10 VMware
Frage von Ghost108Vmware17 Kommentare

Hallo zusammen, versuche gerade mit Hilfe des vshpere clients eine virtuelle Windows 10 maschine aufzusetzen. 1. virtuelle Maschine erstellt ...

Exchange Server
SBS 2011 E-Mails können gesendet werden, aber nicht von extern empfangen
Frage von andreas1234Exchange Server14 Kommentare

Hallo Community, ich habe das Problem, dass seit knapp zwei Wochen die E-Mails von meinem SBS 2011 einwandfrei gesendet ...

Voice over IP
Telefonstörung - Ortsrufnummern kein Verbindungsaufbau
Frage von Windows10GegnerVoice over IP10 Kommentare

Hallo, sowohl bei uns als auch beim Opa ist es über VoIP nicht möglich Ortsrufnummern anzurufen. Es kommt nach ...

Windows Server
Server 2012 über Eingabeaufforderung devmgmt.msc geht nicht
gelöst Frage von achim222Windows Server9 Kommentare

Hallo, ich habe hier einen Server 2012 der im Reparaturmodus startet. Es liegt an einem falschen VirtIO Treiber für ...