Textverketten (mit VBA (?))

[rate mit]

Hallo zusammen,

heute möchte ich euch um Hilfe bitten...

In der beigefügten Datei habe ich verschiedene Spalten, deren Text ich zusammenfügen möchte. Es sind immer 6 Spalten ein Block... und das dann 10 x - innerhalb des Blockes sind es Paare (4 + 1 / 5 + 2 / 6 + 3 Spalte)

In Zelle CO3 habe ich dies per Formel 

Code:

="("&AI3&" x "&AF3&" / "&AJ3&" x "&AG3&" / "&AK3&" x "&AH3&")"

 
erledigt...

Es sollen aber nur Ergebnisse angezeigt werden, die ungleich Null oder leer sind... (siehe Wunschergebnis Spalte CP...)

Nun könnte ich natürlich alles händisch bis Spalte CM ausfüllen, aber es wird sicherlich eine viel eleganter Lösung geben... ich weiß nur nicht genau, wie anfangen... muss man erst prüfen, ob die Zelle leer ist, dann eine Schleife einbauen und dann das Ganze auch noch verknüpfen???

[Fennek]

Hallo,

teste mal

Code:

Sub F_en()
Dim Tx As String, Out As String, Sp As Integer, Ar

Sp = 93
Range("CQ3:CQ24").Clear
For i = 3 To 24
    Tx = Cells(i, Sp)
    Tx = Mid(Tx, 2, Len(Tx) - 2)
    Tx = Replace(Tx, "x", "*")
    
    Ar = Split(Tx, "/")
    
    For a = 0 To UBound(Ar)
        ret = Evaluate(Trim(Ar(a)))
        If Not IsError(ret) Then
            If ret > 0 Then Out = Out & " / " & Ar(a)
        End If
    Next a
    
    If Len(Out) Then Cells(i, Sp + 2) = Replace("(" & Mid(Out, 3) & ")", "*", "x")
    Out = ""
Next i
End Sub

Zur Kontrolle schreibt der Code eine Spalte weiter rechts.

mfg

[Elex]

Hi

meinst du so?

Code:

Public Sub abcd()
Dim j As Long, jj As Long, offset As Long, strA As String, Werte

Werte = Range("AF3:CM24")
offset = 0

For j = 1 To 22
  strA = ""
  For offset = 0 To 54 Step 6
    For jj = 1 To 3
      If (Val(Werte(j, offset + jj)) * Val(Werte(j, 3 + offset + jj))) > 0 Then strA = strA & " / " & Werte(j, 3 + offset + jj) & " x " & Werte(j, offset + jj)
    Next jj
  Next offset
  If strA <> "" Then
     Werte(j, 1) = "(" & Mid(strA, 4) & ")"
  Else
     Werte(j, 1) = ""
  End If
Next j
Range("CQ3:CQ24") = Application.Index(Werte, , 1)
End Sub

Gruß Elex

[BoskoBiati]

Hi,

oder einfach so:

Code:

=WECHSELN("("&WENN((AI3>0)*(AF3>0);AI3&" x "&AF3&" / ";"")&WENN((AJ3>0)*(AG3>0);AJ3&" x "&AG3&" / ";"")&WENN((AK3>0)*(AH3>0);AK3&" x "&AH3;"")&")";"()";"")

[rate mit]

Hallo Fennek,

vielen Dank für deinen Vorschlag... Wenn ich den Code richtig verstanden habe, dann durchsucht er "nur" die Spalte CO... 


Ich befürchte, das ich mich nicht ganz deutlich ausgedrückt habe... 

Es gibt 10 Blöcke (AF - AK ; AL - AQ .... CH - CM)

Beim ersten Block gehört Spalte AI zu AF - AJ zu AG - AK zu AH (verbunden mit "x")

Code:

="("&AI3&" x "&AF3&" / "&AJ3&" x "&AG3&" / "&AK3&" x "&AH3&")"

ergibt 

(1 x 44 / 1 x 51 / 4 x 55)

so weit - so gut...

Nun möchte ich aber nicht immer die Formel händisch so zusammenstellen, sondern das über eine Formel (ein Makro) erledigen lassen... und das Ganze dann natürlich für alle 10 Blöcke...

[BoskoBiati]

Hi,

mit Formel, in CO und nach rechts ziehen.

[rate mit]

Hallo Elex,

vielen Dank - dein Vorschlag kommt dem schon sehr nahe, was ich suche.... ich möchte die Ergebnisse pro Block pro Spalte haben... Also Block 1 in CO - Block 2 in CP usw...

Wenn es nicht zu viel Mühe macht, könntest du bitte versuchen, eine Anmerkung zu schreiben, damit ich versuchen kann, den Code zu verstehen...




Hallo BoskoBiati,

auch dir Vielen Dank...

Bei dieser Formel wird mir noch in Zelle CQ 5 ein "/" angezeigt... ist zwar kein Weltuntergang, sieht aber so aus, als ob da noch etwas fehlen würde... und so ist es ja nicht, daher ist es störend... 

Wenn ich dann die Formel nach rechts ziehe, dann ist das Chaos perfekt... ist aber meine Schuld, weil ich es nicht gleich gut genug beschrieben hatte... ENTSCHULDIGUNG....

---

Hi,
mit Formel, in CO und nach rechts ziehen.
Gruß
Edgar

Das passt leider nicht ganz... z.B. erhalte ich in CP7 "(x4)"  und in CQ7 und CR7 "(x4 /)...

In CP12 steht dann "(2332 x 21)" richtig wäre hier aber ="("&AO12&" x "&AL12&")" = "(17 x 2232)"

[Elex]

Dann so.

Code:

Public Sub abcd()
Dim j As Long, jj As Long, offS As Long, strA As String, Werte

Werte = Range("AF3:CM24")  'Daten ins Array
offS = 0

For offS = 0 To 54 Step 6  'Schleife 10 Blöcke
   For j = 1 To 22         'Schleife 22 Zeilen
    strA = ""
      For jj = 1 To 3      'Schleife 3 Spalte im Block
        If (Val(Werte(j, offS + jj)) * Val(Werte(j, 3 + offS + jj))) > 0 Then strA = strA & " / " & Werte(j, 3 + offS + jj) & " x " & Werte(j, offS + jj)
      Next jj
      If strA <> "" Then
        Werte(j, 1) = "(" & Mid(strA, 4) & ")"  'Ergebnis in Spalte 1 des Array zwischen speichern
      Else
        Werte(j, 1) = ""
      End If
   Next j
Range("CO3:CO24").offset(, offS / 6) = Application.Index(Werte, , 1)  'Blockweise Spalte 1 in Zellen schreiben
Next offS
End Sub

[rate mit]

Hallo Elex,

vielen Vielen Dank für die Lösung und auch für die Bemerkungen... genauso sollte das Ergebnis aussehen...

[BoskoBiati]

Hi,

ok, dann hier mit verbesserter Formel:


  Textverketten.xlsm (Größe: 23,94 KB / Downloads: 1)

Code:

=WECHSELN(WECHSELN("("&WENN((INDEX(3:3;35+(SPALTE(A1)-1)*6)>0)*(INDEX(3:3;32+(SPALTE(A1)-1)*6)>0);INDEX(3:3;35+(SPALTE(A1)-1)*6)&" x "&INDEX(3:3;32+(SPALTE(A1)-1)*6)&" / ";"")&WENN((INDEX(3:3;36+(SPALTE(A1)-1)*6)>0)*(INDEX(3:3;33+(SPALTE(A1)-1)*6)>0);INDEX(3:3;36+(SPALTE(A1)-1)*6)&" x "&INDEX(3:3;33+(SPALTE(A1)-1)*6)&" / ";"")&WENN((INDEX(3:3;37+(SPALTE(A1)-1)*6)>0)*(INDEX(3:3;34+(SPALTE(A1)-1)*6)>0);INDEX(3:3;37+(SPALTE(A1)-1)*6)&" x "&INDEX(3:3;34+(SPALTE(A1)-1)*6);"")&")";"()";"");" / )";")")