Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 12:28:32
Formelfehler aufgrund Einfügen einer Zeile
18.04.2024 11:51:04
Aus Listbox Spalte als Wert zurück bekommen
18.04.2024 11:36:51
Beim Öffnen je nach Datum zu bestimmter Zelle springen
18.04.2024 11:16:38
Pfade werden mit Anführungszeichen "" versehen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
768to772
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
768to772
768to772
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Mit vba verketten

Mit vba verketten
31.05.2006 22:58:44
Aksoy
Hallo,
habe folgendes Problem:
mochte die zeilen von einer Spalte zusammenführen, die Anzahl der Zeilen jeder Spalte ist verschieden.
D.h,
a a a
b b b
c c c
d d
e

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
?!?
31.05.2006 23:02:16
{Boris}
Hi,
ich versteh kein Wort. Wo soll was zusammengeführt werden? Wo soll die Ausgabe erfolgen? Um welchen Bereich (wieviele Spalten) geht es überhaupt?
Wie man Werte verkettet, weißt du aber?!?
Grüße Boris
AW: ?!?
31.05.2006 23:54:14
Aksoy
https://www.herber.de/bbs/user/34071.xls
ja, wie man manuell verkettet weiss ich.
Nur es sollte schon mit vba gemacht werden, da ich mehrere Spalten habe.
Die Anfangszeile und die Endzeile in den Spalten kann ich per makro herausfinden, mit diesen Werten müsste ich die Zellen dazwischen verketten.
AW: ?!?
01.06.2006 00:40:02
Josef Ehrensberger
Hallo ?
Vieleicht so1
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Verketten()
Dim varTemp As Variant
Dim lngLast As Long
Dim intCol As Integer

For intCol = 1 To 3 ' Für die Spalten 1 bis 3
  lngLast = Cells(Rows.Count, intCol).End(xlUp).Row
  If lngLast > 1 Then
    varTemp = Range(Cells(1, intCol), Cells(lngLast, intCol))
    Range(Cells(1, intCol), Cells(lngLast, intCol)).ClearContents
    Cells(1, intCol) = Join2(varTemp)
  End If
Next

End Sub



Function Join2(ByRef field As Variant, Optional ByVal delimit As String = vbNullString) As String
'zweidimensionales array zu string umwandeln
Dim n As Long, m As Long
Dim temp As String

For n = LBound(field, 2) To UBound(field, 2)
  For m = LBound(field, 1) To UBound(field, 1)
    temp = temp & field(m, n) & delimit
  Next
Next

Join2 = Left(temp, Len(temp) - Len(delimit))

End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: ?!?
03.06.2006 13:41:51
Aksoy
Vielen Dank, funktioniert tadellos.
Ich möchte gerne ein paar Änderungen an dem oberen Makro vornehmen:
- Die Eingangswerte für den unteren bzw. oberen Bereich werden in eine anderen Schleife schon ermittelt, wie kann ich diese hier weiter verwenden. Variabeln (Zwis_2 = untere Wert, Zwis_1 = obere Wert)
- Die aktuelle Spalte wird ebenfalls in einer vorhandenen Schleife festgelegt variable = Spalte_Quell
- Es ist nicht notwendig vor dem einfügen die Quelle zu löschen, da es in das nächste Tabellenblatt eingefügt werden soll "Worksheets(2)" und da jeweils in die Zeile 5 von der aktuellen Spalte.
Kannst du mir da noch weiterhelfen diese Änderungen zu machen ?
Gruss
Anzeige
AW: ?!?
03.06.2006 22:10:18
Josef Ehrensberger
Hallo Aksoy!
Probier's so!
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Verketten(erste_Zeile As Long, letzte_Zeile As Long, Spalte As Integer, Quelle As Worksheet, Ziel As Worksheet)
Dim varTemp As Variant

With Quelle
  varTemp = .Range(.Cells(erste_Zeile, Spalte), .Cells(letzte_Zeile, Spalte))
End With
Ziel.Cells(5, Spalte) = Join2(varTemp)

End Sub


Sub test()
Dim Zwis_1 As Long, Zwis_2 As Long
Dim Spalte_Quell As Integer

'nur zum testen
Zwis_1 = 4
Zwis_2 = 25
Spalte_Quell = 6

Call Verketten(Zwis_1, Zwis_2, Spalte_Quell, Sheets("Tabelle1"), Sheets("Tabelle2"))

End Sub


Function Join2(ByRef field As Variant, Optional ByVal delimit As String = vbNullString) As String
'zweidimensionales array zu string umwandeln
Dim n As Long, m As Long
Dim temp As String

For n = LBound(field, 2) To UBound(field, 2)
  For m = LBound(field, 1) To UBound(field, 1)
    temp = temp & field(m, n) & delimit
  Next
Next

Join2 = Left(temp, Len(temp) - Len(delimit))

End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: ?!?
04.06.2006 00:18:28
Aksoy
Super,
habe da noch eine letzte Frage, wie bekomme ich das ganze in mein vorhandenen Makro integriert ?

Sub Suche()
Spalte_Quell = 0
Spalte_Ziel = 0
Sheets(1).Select
Do
Zeile_Quell = 0
Spalte_Quell = Spalte_Quell + 1
Spalte_Ziel = Spalte_Ziel + 1
Do
Zeile_Quell = Zeile_Quell + 1
Wert$ = Cells(Zeile_Quell, Spalte_Quell)
Loop Until InStr(1, Wert$, "Begriff_1") > 0 Or Zeile_Quell > 600
' Begriff_2 ?
If InStr(1, Wert$, "Begriff_2") Then
' EUR
Worksheets(2).Cells(1, Spalte_Ziel) = Cells(Zeile_Quell, Spalte_Quell)
Zeile_Quell = 0
Do
Zeile_Quell = Zeile_Quell + 1
Wert$ = Cells(Zeile_Quell, Spalte_Quell)
Loop Until InStr(1, Wert$, "Begriff_2") > 0 Or Zeile_Quell > 600
' EUR
Worksheets(2).Cells(2, Spalte_Ziel) = Cells(Zeile_Quell, Spalte_Quell)
Zeile_Quell = 0
Do
Zeile_Quell = Zeile_Quell + 1
Wert$ = Cells(Zeile_Quell, Spalte_Quell)
Loop Until InStr(1, Wert$, "Begriff_3") > 0 Or Zeile_Quell > 600
Zwis_1 = Zeile_Quell - 1
Zeile_Quell = 0
Do
Zeile_Quell = Zeile_Quell + 1
Wert$ = Cells(Zeile_Quell, Spalte_Quell)
Loop Until InStr(1, Wert$, "Begriff_4") > 0 Or Zeile_Quell > 600
Zwis_2 = Zeile_Quell + 5
End If
Loop Until Spalte_Quell = 20
End Sub

Anzeige
AW: ?!?
04.06.2006 10:53:27
Josef Ehrensberger
Hallo Aksoy! (heist du wirklich so?)
Sorry, aber bei deinem Code versteh' ich nur Bahnhof!
Beschreib vielleicht mal was du machen willst, damit ich mir
das ein wenig vorstellen kann.
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: ?!?
04.06.2006 11:13:33
M. Aksoy
Ok,
in dem Code wird nach verschiedenen Begriffen gesucht, und diese werden dann in die gleiche Spalte in das nächsten Tabellblatt eingefügt.
Spalte_Quell = aktuelle Spalte
Spalte_Ziel = aktuellle zu einfügende Spalte (Tabellenblatt 2)
Zeile_Quell = aktuell Zeile ( wo es gerade sucht)
Hier sind die variablen Zwis_1 und Zwis_2 definiert, ab hier könnte dein Code weitermachen, nur zu beachten ist das das ganze Spaltenweise abgefragt wird, also 1. Spalte , mein Code weiter deinem dann 2. Spalte mein Code deiner usw.
Ich weiss der Code ist bisschen durcheinander, aber simple aufgebaut.
Ich hoffe du kommst klar damit.
Gruss
M. Aksoy
Anzeige
Trozdem Bahnhof!
04.06.2006 11:26:28
Josef Ehrensberger
Hallo M.!
Kannst du nicht ein Beispiel hochladen?
Mit Beschreibung wonach gesucht wird und was, wo verkettet werden soll.
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Trozdem Bahnhof!
04.06.2006 11:53:13
M. Aksoy
Hallo,
beispiel kein Problem nur das Ganze ist türkisch :-),
https://www.herber.de/bbs/user/34155.xls
aber ich versuche es :
zuerst wird das Begriff "Listelendiği kategori" gesucht bzw. wo in welche Zeile es steht dieser wird dann in die 1. Zeile in das Tabellenblatt(2) kopiert.
Dann die nächsten Begriffe der reihe nach "Ürün #:2" , "Tekil" -das ist dann die untere Position für die Verkettung-, "Ürün Açıklaması # 2" -obere Position Verkettung-
Gruss
Anzeige
AW: Trozdem Bahnhof!
04.06.2006 12:48:39
Josef Ehrensberger
Hallo M!
Obwohl mein Türkisch noch ausbaufähig ist;-))
probier mal!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub verketten()
Dim rngList As Range, rngFirst As Range, rngLast As Range, rng As Range
Dim strList As String, strFirst As String, strLast As String
Dim objSh1 As Worksheet, objSh2 As Worksheet
Dim intCol As Integer, intLast As Integer, intC As Integer
Dim varValues As Variant

strList = "Listelendi?i kategori:"
strFirst = "Ürün #"
strLast = "Tekil"

Set objSh1 = Sheets("Tabelle1") 'Quelltabelle
Set objSh2 = Sheets("Tabelle2") 'Zieltabelle

'Anzahl der zu durchsuchenden Spalten anhand Zeile 2 ermitteln
intLast = objSh1.Cells(2, Columns.Count).End(xlToLeft).Column

For intC = 1 To intLast
  'suchen nach strList
  Set rngList = objSh1.Columns(intC).Find(strList, lookat:=xlPart, after:=objSh1.Cells(1, intC))
  If Not rngList Is Nothing Then
    intCol = intCol + 1
    objSh2.Cells(1, intCol) = rngList
    'suchen nach strFirst, ab Zeile mit strList
    Set rngFirst = objSh1.Columns(intC).Find(strFirst, lookat:=xlPart, after:=rngList)
    If Not rngFirst Is Nothing Then
      'suchen nach strLast, ab Zeile mit strFirst
      Set rngLast = objSh1.Columns(intC).Find(strLast, lookat:=xlPart, after:=rngFirst)
      If Not rngLast Is Nothing Then
        With objSh1
          varValues = .Range(.Cells(rngFirst.Row, intCol), .Cells(rngLast.Row, intCol))
        End With
        objSh2.Cells(2, intCol) = Join2(varValues)
      End If
      Set rngLast = Nothing
    End If
    Set rngFirst = Nothing
    Set rngList = Nothing
  End If
Next

End Sub


Function Join2(field As Variant, Optional delimit As String) As String
'zweidimensionales array zu string umwandeln
Dim n As Long, m As Long
Dim temp As String


If delimit = "" Then delimit = " "


For n = LBound(field, 2) To UBound(field, 2)
  For m = LBound(field, 1) To UBound(field, 1)
    
    temp = temp & field(m, n) & delimit
    
  Next
Next

Join2 = Left(temp, Len(temp) - 1)

End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Trozdem Bahnhof!
04.06.2006 13:55:25
M. Aksoy
Super,
keins du folgendes noch mit einbauen, weil meine VBA kentnisse hier nicht mehr ausreichen.
strList1 = "Ürün #:2" - diese bitte in die 2. Zeile einfügen
strFirst = "Ürün Aç?klamas? #"
und die Verkettung bitte in die 5. Zeile, und hier ist noch zu beachten das ab der 5. Zeile von strFirst und 1. Zeile vor strlast verkettet werden soll.
Kannst du da noch ändern ?
Gruss M. Aksoy
AW: Trozdem Bahnhof!
04.06.2006 14:14:06
Josef Ehrensberger
Hallo M!
Ich hoffe, daß ich dich richtig verstanden habe.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub verketten()
Dim rngList As Range, rngFirst As Range, rngLast As Range, rng As Range
Dim strList As String, strList1 As String, strFirst As String, strLast As String
Dim objSh1 As Worksheet, objSh2 As Worksheet
Dim intCol As Integer, intLast As Integer, intC As Integer
Dim varValues As Variant

strList = "Listelendi?i kategori:"
strList1 = "Ürün #:2"
strFirst = "Ürün Aç?klamas? #"
strLast = "Tekil"

Set objSh1 = Sheets("Tabelle1") 'Quelltabelle
Set objSh2 = Sheets("Tabelle2") 'Zieltabelle

'Anzahl der zu durchsuchenden Spalten anhand Zeile 2 ermitteln
intLast = objSh1.Cells(2, Columns.Count).End(xlToLeft).Column

For intC = 1 To intLast
  'suchen nach strList
  Set rngList = objSh1.Columns(intC).Find(strList, lookat:=xlPart, after:=objSh1.Cells(1, intC))
  If Not rngList Is Nothing Then
    intCol = intCol + 1
    objSh2.Cells(1, intCol) = rngList
    'suchen nach strList1
    Set rngFirst = objSh1.Columns(intC).Find(strList1, lookat:=xlPart, after:=rngList)
    If Not rngFirst Is Nothing Then
      objSh2.Cells(2, intCol) = rngFirst
    End If
    Set rngFirst = Nothing
    'suchen nach strFirst, ab Zeile mit strList
    Set rngFirst = objSh1.Columns(intC).Find(strFirst, lookat:=xlPart, after:=rngList)
    If Not rngFirst Is Nothing Then
      'suchen nach strLast, ab Zeile mit strFirst
      Set rngLast = objSh1.Columns(intC).Find(strLast, lookat:=xlPart, after:=rngFirst)
      If Not rngLast Is Nothing Then
        With objSh1
          varValues = .Range(.Cells(rngFirst.Row + 5, intCol), .Cells(rngLast.Row - 1, intCol))
        End With
        objSh2.Cells(5, intCol) = Join2(varValues)
      End If
      Set rngLast = Nothing
    End If
    Set rngFirst = Nothing
    Set rngList = Nothing
  End If
Next

End Sub


Function Join2(field As Variant, Optional delimit As String) As String
'zweidimensionales array zu string umwandeln
Dim n As Long, m As Long
Dim temp As String


If delimit = "" Then delimit = " "


For n = LBound(field, 2) To UBound(field, 2)
  For m = LBound(field, 1) To UBound(field, 1)
    
    temp = temp & field(m, n) & delimit
    
  Next
Next

Join2 = Left(temp, Len(temp) - 1)

End Function


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Trozdem Bahnhof!
04.06.2006 18:34:40
M. Aksoy
Ok,
es läuft nur die Verkettung bring es durcheinander, d.h. Verkettung von mehreren Spalten.
Kann es darin liegen das in manchen Spalten die Kriterien nicht erfüllt werden, kann man es so machen das wenn es das erste Suchbegriff nicht findet "Listelendi?i kategori:", dann diese Spalte auslässte und bei der nächsten weitermacht.
Gruss
AW: Trozdem Bahnhof!
04.06.2006 19:09:33
Josef Ehrensberger
Hallo M!
Das wird bereits so gehandelt, daß nur weitergesucht wird, wenn der erste Begriff gefunden wird!
Das mehrere Spalten verkettet werden, kann ich mir nicht vorstellen, weil
der Code immer nur auf eine Spalte zugreift!
Ich hab den Code nochmal ein wenig angepasst!
Sub verketten()
Dim rngList As Range, rngFirst As Range, rngLast As Range, rng As Range
Dim strList As String, strList1 As String, strFirst As String, strLast As String
Dim objSh1 As Worksheet, objSh2 As Worksheet
Dim intLast As Integer, intC As Integer
Dim varValues As Variant

strList = "Listelendi?i kategori:"
strList1 = "Ürün #:2"
strFirst = "Ürün Aç?klamas? #"
strLast = "Tekil"

Set objSh1 = Sheets("Tabelle1") 'Quelltabelle
Set objSh2 = Sheets("Tabelle2") 'Zieltabelle

'Anzahl der zu durchsuchenden Spalten anhand Zeile 2 ermitteln
intLast = objSh1.Cells(2, Columns.Count).End(xlToLeft).Column

For intC = 1 To intLast
  'suchen nach strList
  Set rngList = objSh1.Columns(intC).Find(strList, lookat:=xlPart, after:=objSh1.Cells(1, intC))
  If Not rngList Is Nothing Then
    objSh2.Cells(1, intC) = rngList
    'suchen nach strList1
    Set rngFirst = objSh1.Columns(intC).Find(strList1, lookat:=xlPart, after:=rngList)
    If Not rngFirst Is Nothing Then
      objSh2.Cells(2, intC) = rngFirst
    End If
    Set rngFirst = Nothing
    'suchen nach strFirst, ab Zeile mit strList
    Set rngFirst = objSh1.Columns(intC).Find(strFirst, lookat:=xlPart, after:=rngList)
    If Not rngFirst Is Nothing Then
      'suchen nach strLast, ab Zeile mit strFirst
      Set rngLast = objSh1.Columns(intC).Find(strLast, lookat:=xlPart, after:=rngFirst)
      If Not rngLast Is Nothing Then
        With objSh1
          varValues = .Range(.Cells(rngFirst.Row + 5, intC), .Cells(rngLast.Row - 1, intC))
        End With
        objSh2.Cells(5, intC) = Join2(varValues)
      End If
      Set rngLast = Nothing
    End If
    Set rngFirst = Nothing
    Set rngList = Nothing
  End If
  Erase varValues
Next

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Trozdem Bahnhof!
04.06.2006 20:25:20
M. Aksoy
Ok, jetzt funktioniert es :-),
Wo kann ich was verstellen das es zwischen den Zeilen ein ENTER einfügt wird.
Aber vielen vielen Dank
Gruss
M. Aksoy
AW: Trozdem Bahnhof!
04.06.2006 20:34:15
Josef Ehrensberger
Hallo M!
Die Funktion Join2() hat den Parameter "delimit"!
Gib dort einfach einen Umbruch an.
objSh2.Cells(5, intC) = Join2(varValues, vbLf)

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige