Anzeige
Archiv - Navigation
384to388
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
384to388
384to388
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datenbank

Datenbank
24.02.2004 09:06:39
Roger
Hallo zusammen
Habe ein klizekleines Excel-Problem.
Beschreibung:
Habe eine Datenbank z.B. Spalten A-B (A= Land, B= Kontinent)(Zellen A1, B1
Zellen: A2-B5 (A2: Deutschland, A3: Oesterreich, A4: Kenya, A5 = Schweiz)B2= Europa, B3 = Europa, B4 = Afrika, B5= Europa)
Jetzt möchte ich auf einem neuen Excel Blatt alle europäischen Staaten und alle afrikanischen Staaten, jeweils beginnend mit der Zelle A2.
Wie ist dies möglich.
Herzlichen Dank
Gruss Roger

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenbank
24.02.2004 09:25:23
cunradus
unelegant über sverweis, hierfür mußt du aber den Kontinent den Ländern voranstellen - also spalten vertauschen, oder land in spalte hinter kontinent kopieren und ausblenden.
conrad
AW: Datenbank
24.02.2004 09:28:59
AndreasS
Hi,hier ein "kleines" Makro:

Sub Suche_Kopie()
On Error Resume Next
Application.ScreenUpdating = False
Wenn_Kontinent_Europa_dann_Kopie
Wenn_Kontinent_Afrika_dann_Kopie
Application.ScreenUpdating = True
End Sub


Sub Wenn_Kontinent_Europa_dann_Kopie()
Dim iRow%
Dim i$
i = "Europa"
With Worksheets("Tabelle1").Range("B:B") 'hier Bereich anpassen
Set c = .Find(i, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Set c = .FindNext(c)
c.EntireRow.Select
With Sheets("Tabelle2")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveCell.EntireRow.Copy Worksheets("Tabelle2").Rows(iRow)
End With
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
End Sub


Sub Wenn_Kontinent_Afrika_dann_Kopie()
Dim ii$
ii = "Afrika"
With Worksheets("Tabelle1").Range("B:B") 'hier Bereich anpassen
Set c1 = .Find(ii, LookIn:=xlValues)
If Not c1 Is Nothing Then
firstaddress = c1.Address
Do
Set c1 = .FindNext(c1)
c1.EntireRow.Select
With Sheets("Tabelle2")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveCell.EntireRow.Copy Worksheets("Tabelle2").Rows(iRow)
End With
Loop While Not c1 Is Nothing And c1.Address <> firstaddress
End If
End With
End Sub

Gruß Andreas
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige