Freie Adressen finden und in andere Tabelle eintra

Bild

Betrifft: Freie Adressen finden und in andere Tabelle eintra
von: Markus
Geschrieben am: 13.02.2005 23:24:39
Hallo liebe Gemeinde,
habe vor einiger Zeit schon mal ein Post gestartet, leider konnte mir bis jetzt niemenad helfen.
Vielleicht dieses mal.
In einer Tabelle (im Anhang ist ein Beispiel) sind mehrere Maschinen eingetragen (Spalte B) jede dieser Maschinen ist mit 4 Karten bestückt (welche Karte ist in Spalte C) jede dieser Karten kann 254 Adressen bekommen (das steht in Spalte A). Da diese Tabelle immer erweitert wird, und auch neue Maschinen dazu kommen, wäre es nun hilfreich auf einem anderem Tabellenblatt die Freien Adressen nach Maschine und Karte sortiert an zu zeigen. Hat einer von euch eine Idee, wie man so etwas anstellt ? Vielen Dank im voraus.
https://www.herber.de/bbs/user/18015.xls
Gruß Markus

Bild

Betrifft: AW: Freie Adressen finden und in andere Tabelle ei
von: Josef Ehrensberger
Geschrieben am: 14.02.2005 00:31:39
Hallo Markus!
Ein Ansatz.
https://www.herber.de/bbs/user/18016.xls

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Bild

Betrifft: AW: Freie Adressen finden und in andere Tabelle ei
von: Markus
Geschrieben am: 14.02.2005 01:20:42
Da ist noch was....
habe probiert das Makro auf meine Echte Tabelle zu konvertieren.
Leider ohne Erfolg, da die Daten nicht wie in der Beispiel Tabelle in den Spalten a-c Stehen, sondern in den Spalten AB-AD und davor sowie dahinter noch Daten eingetragen sind.
Hast Du da nochmal einen Lösungsansatz für mich ?
Danke und Gruß Markus
Bild

Betrifft: AW: Freie Adressen finden und in andere Tabelle ei
von: Josef Ehrensberger
Geschrieben am: 14.02.2005 12:02:44
Hallo Markus!
Eine Beispieltabelle sollte schon dem Original gleichen!
Probier mal diesen Code.


      
Option Explicit
Sub freieNummern()
Dim rng As Range
Dim lastRow As Long, lRow As Long
Dim wksL As Worksheet, wksF As Worksheet
Dim icol As Integer, n As Integer
Set wksL = Sheets("Gesamtliste")
Set wksF = Sheets("Freie Adressen")
lastRow = IIf(wksL.Range(
"AC65536") <> "", 65536, _
            wksL.Range(
"AC65536").End(xlUp).Row)
            
wksF.Range(
"A3:IV257").Font.ColorIndex = xlAutomatic
wksF.Range(
"A3:IV257").Font.Bold = False
            
On Error Resume Next
   
For lRow = 4 To lastRow
   
   
If wksL.Cells(lRow, 28) <> 0 And wksL.Cells(lRow, 29) <> 0 _
                                 
And wksL.Cells(lRow, 30) <> 0 Then
                                 
   
Set rng = wksF.Range("1:1").Find(wksL.Cells(lRow, 29))
   
      
If Not rng Is Nothing Then
      
         
With wksF.Cells(wksL.Cells(lRow, 28) + 2, _
                     rng.Column + wksL.Cells(lRow, 30) - 1)
                     
         .Font.ColorIndex = 3
         .Font.Bold = 
True
         
End With
      
      
Else
      
         
'Maschinennummer nicht vorhanden
         icol = wksF.Cells(1, 256).End(xlToLeft).Column + 4
         
         wksF.Cells(1, icol) = wksL.Cells(lRow, 2)
         wksF.Cells(2, icol) = 
"Karte 1"
         wksF.Cells(2, icol + 1) = 
"Karte 2"
         wksF.Cells(2, icol + 2) = 
"Karte 2"
         wksF.Cells(2, icol + 3) = 
"Karte 4"
         
         
For n = 1 To 255
         wksF.Range(wksF.Cells(2 + n, icol), wksF.Cells(2 + n, icol + 3)).Value = n
         
Next
         
         
With wksF.Cells(wksL.Cells(lRow, 28) + 2, icol + wksL.Cells(lRow, 30) - 1)
         .Font.ColorIndex = 3
         .Font.Bold = 
True
         
End With
      
      
End If
      
      
Set rng = Nothing
      
      
End If
   
   
Next
End Sub 

     Code eingefügt mit Syntaxhighlighter 3.0


Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Bild

Betrifft: AW: Freie Adressen finden und in andere Tabelle ei
von: Markus
Geschrieben am: 15.02.2005 22:37:15
Hallo Sepp,
leider funktioniert es nicht so richtig. Würde dir gerne mal die Tabelle als original senden. Das Makro holt den Maschinennamen immer aus Spalte B. Ich möchte abe nicht die Tabelle ins Forum posten. Hast Du ne Adresse für mich ?
Gruß Markus
Danke...
Die Zahlen zu ändern war auch mein gedanke, leider hatte ich dann das gleiche Ergebnis wie jetzt.
Bild

Betrifft: AW: Freie Adressen finden und in andere Tabelle ei
von: Josef Ehrensberger
Geschrieben am: 15.02.2005 22:46:29
Hallo Markus!
j.ehrensberger[at]aon.at

Gruß Sepp
Bild

Betrifft: AW: Freie Adressen finden und in andere Tabelle ei
von: Markus
Geschrieben am: 18.02.2005 23:15:47
Hallo Sepp,
vielen lieben Dank.
hast mir viel Arbeit erspart.
Gruß Markus
p.s. das Forum ist einfach nur genial
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Freie Adressen finden und in andere Tabelle eintra"