Microsoft Excel

Herbers Excel/VBA-Archiv

Leerspalte zwischen zwei Informationen | Herbers Excel-Forum


Betrifft: Leerspalte zwischen zwei Informationen von: Kai
Geschrieben am: 28.01.2010 16:38:56

Hallo

ich schreibe in eine Zeile informationen rein:

With Sheets("Datenbestand")
.Range("C24:F33").Value = ""
.Range("C24").Resize(UBound(meAr, 1), UBound(meAr, 2) + 1) = meAr
End With

Passt soweit.

nun soll zwischen (UBound(meAr, 1) und (UBound(meAr, 2) eine freie Spalte sein. wie mache ist das ?

Muss dazu sagen, das ist nur ein kleiner Schnipsel von meiner SUB.

Wenn es daraus nicht klar wird , stelle ich natütlich mehr zur Verfügung.

Falls jemand ein Antwort hat, Danke

Gruss
Kai

  

Betrifft: baue Dei Array so auf von: Tino
Geschrieben am: 28.01.2010 16:48:45

Hallo,
das diese leer Spalte schon vorhanden ist.

Gruß Tino


  

Betrifft: OT: Area Dei - ein göttliches Feld! ;-) orT von: Luc:-?
Geschrieben am: 28.01.2010 17:58:19

Gruß Luc :-?


  

Betrifft: AW: OT: was ist Dei? von: Tino
Geschrieben am: 28.01.2010 18:22:50

Deutsches Entomologisches Institut? ;-)

Gruß Tino


  

Betrifft: Deididdeldei von: Reinhard
Geschrieben am: 28.01.2010 18:32:37

Hallo Tino,

Luc gibt wieder an :-)

Opus dei bedeutet göttliches Feld.

Area dei wird was ähnliches sein *mutmaß*

Gruß
Reinhard


  

Betrifft: Nee, mein Lieber, umgekehrt...? von: Luc:-?
Geschrieben am: 28.01.2010 18:41:04

Was heißt hier angeben! Den Verein mit dem Namen kennt man doch. Die geben an, indem sie sich „Werk Gottes“ nennen! Das Andere hatte ich schon übersetzt, weshalb es dir wohl in die „Freud'sche Tastatur“ geflossen ist, Reinhard... ;-)
Gruß Luc :-?


  

Betrifft: OT: Der Genitiv von DEUS, der ja nach... von: Luc:-?
Geschrieben am: 28.01.2010 18:35:46

...dem Verständnis gewisser Kreise auch AG und Schirmherr des DEI (in deinem Sinne) und gleichzeitig seines Forschungsggstandes und der Forscher ist, Tino,
also ein Multifktionär... ;-)
Gruß Luc :-?


  

Betrifft: OT: also was gutes, oder ;-) von: Tino
Geschrieben am: 28.01.2010 18:39:36




  

Betrifft: Wie man's nimmt... ;-) Gruß owT von: Luc:-?
Geschrieben am: 28.01.2010 18:41:53

:-?


  

Betrifft: oder teste mal diesen Code... von: Tino
Geschrieben am: 28.01.2010 17:13:11

Hallo,
hier wird zwischen jede Spalte eine leere eingefügt.

Sub LeerSpalteEinfuegen(ByRef meAr)
Dim NeuAr()
Dim A As Long, AA As Long, AAA As Long

ReDim Preserve NeuAr(1 To UBound(meAr), 1 To UBound(meAr, 2) + UBound(meAr, 2) - 1)

For A = 1 To UBound(meAr)
   AAA = 1
   For AA = 1 To UBound(meAr, 2)
        NeuAr(A, AAA) = meAr(A, AA)
        AAA = AAA + 2
   Next AA
Next A

meAr = NeuAr
End Sub
Den Aufruf machst Du so, vor Deiner With Anweisung.
LeerSpalteEinfuegen meAr
oder auch
Call LeerSpalteEinfuegen (meAr)
Danach wie gehabt in Deine Zellen schreiben.
.Range("C24").Resize(UBound(meAr, 1), UBound(meAr, 2) + 1) = meAr
Gruß Tino


  

Betrifft: nochmal verbessert... von: Tino
Geschrieben am: 28.01.2010 17:36:06

Hallo,
damit dieser Code auch für andere Aufbauten eines Array funktioniert.
z. Bsp. meAr(1 to 10,0 to 10) oder meAr(9,11) usw...

Sub LeerSpalteEinfuegen(ByRef meAr)
Dim NeuAr()
Dim A As Long, AA As Long, AAA As Long

ReDim NeuAr(LBound(meAr) To UBound(meAr), _
            LBound(meAr, 2) To UBound(meAr, 2) + UBound(meAr, 2) - 1)

For A = LBound(meAr) To UBound(meAr)
   AAA = LBound(meAr, 2)
   For AA = LBound(meAr, 2) To UBound(meAr, 2)
        NeuAr(A, AAA) = meAr(A, AA)
        AAA = AAA + 2
   Next AA
Next A

meAr = NeuAr
End Sub
Gruß Tino


  

Betrifft: immer noch Probleme... von: Kai
Geschrieben am: 29.01.2010 07:48:28

Hallo Tino,

vielen Dank für Deine Mühe. Leider funktioniert das mit der Leeren Spelta garnicht, die wird entweder nur vor die ersten Spalte gemacht, oder die daten landen in andren Spalten :-( .
Liegt sicher auch an mir.!

Vielleicht können wir es so schneller lösen, wenn ich mal alles zeige:


Sub Formular()

Dim Bereich As Range
Dim A As Long, B As Long
Dim Zelle As Range, CZelle As Range
Dim meAr(), LCount As Long

Set Bereich = Sheets("Ablage").Columns(4)

B = Application.WorksheetFunction.CountIf(Bereich, "Total C*")
ReDim meAr(B, 2)
For A = 1 To B
 If A = 1 Then
     
     Set Zelle = Bereich.Find("Total C*", , xlValues, 2, 1, 1, False, False)
     Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
  
    If Not CZelle Is Nothing Then
      meAr(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
      meAr(LCount, 0) = Left$(meAr(LCount, 0), InStr(meAr(LCount, 0), "]") - 1)
      meAr(LCount, 1) = Sheets("Ablage").Cells(CZelle.Row, 5)
      meAr(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row + 1, 5)
      LCount = LCount + 1
    End If
 
 Else
    
    Set Zelle = Bereich.Find("Total C*", Zelle, xlValues, 2, 1, 1, False, False)
    Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
    
    If Not CZelle Is Nothing Then
      meAr(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
      meAr(LCount, 0) = Left$(meAr(LCount, 0), InStr(meAr(LCount, 0), "]") - 1)
      meAr(LCount, 1) = Sheets("Ablage").Cells(CZelle.Row, 5)
      meAr(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row + 1, 5)
      LCount = LCount + 1
    End If
 
 End If

Next A
 
With Sheets("Datenbestand")
 .Range("C24:E33").Value = ""
 .Range("C24").Resize(UBound(meAr, 1), UBound(meAr, 2) + 1) = meAr
End With

End Sub

Also, die erste INformationen soll in B bleiben, die zweite in C und di Dritte in D. Der Inhalt, der seither in E war, soll nun eins nach rechts rutschen, also in F. (Esoll nun leer bleiben)

Was muss ich denn da ändern ?

Danke Kai


  

Betrifft: so sollte es aber gehen. von: Tino
Geschrieben am: 29.01.2010 08:07:00

Hallo,

Sub Formular()

Dim Bereich As Range
Dim A As Long, B As Long
Dim Zelle As Range, CZelle As Range
Dim mear(), LCount As Long

Set Bereich = Sheets("Ablage").Columns(4)

B = Application.WorksheetFunction.CountIf(Bereich, "Total C*")

ReDim mear(B, 4) '* 5 Spalten

For A = 1 To B
 If A = 1 Then
     
     Set Zelle = Bereich.Find("Total C*", , xlValues, 2, 1, 1, False, False)
     Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
  
    If Not CZelle Is Nothing Then
      mear(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "[")) 'in Spalte 1
      mear(LCount, 0) = Left$(mear(LCount, 0), InStr(mear(LCount, 0), "]") - 1) 'in Spalte 1 ?
      mear(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row, 5) 'in Spalte 3
      mear(LCount, 4) = Sheets("Ablage").Cells(CZelle.Row + 1, 5) 'in Spalte 5
      LCount = LCount + 1
    End If
 
 Else
    
    Set Zelle = Bereich.Find("Total C*", Zelle, xlValues, 2, 1, 1, False, False)
    Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
    
    If Not CZelle Is Nothing Then
      mear(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "[")) 'in Spalte 1
      mear(LCount, 0) = Left$(mear(LCount, 0), InStr(mear(LCount, 0), "]") - 1) 'in Spalte 1 ?
      mear(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row, 5) 'in Spalte 3
      mear(LCount, 4) = Sheets("Ablage").Cells(CZelle.Row + 1, 5) 'in Spalte 5
      LCount = LCount + 1
    End If
 
 End If

Next A
 
With Sheets("Datenbestand")
 .Range("C24:E33").Value = ""
 .Range("C24").Resize(UBound(mear, 1), UBound(mear, 2) + 1) = mear
End With

End Sub
Gruß Tino


  

Betrifft: nur so am rande. von: Tino
Geschrieben am: 29.01.2010 08:16:22

Hallo,
ist Dir bekannt das durch das fehlende +1 bei UBound(meAr, 1) Du die erste Zeile des Array verlierst?
Weil Dein Array bei 0 anfängt.

Gruß Tino


  

Betrifft: Danke Tino, jetzt funktioniert es :-) owT von: Kai
Geschrieben am: 29.01.2010 10:27:19




Beiträge aus den Excel-Beispielen zum Thema "Leerspalte zwischen zwei Informationen"