Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
264to268
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
264to268
264to268
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kategorien umorganisieren

Kategorien umorganisieren
04.06.2003 16:45:15
Sebastian
Hallo,
ich habe ein Excelsheet das folgendermasen aufgebaut ist:
.........|..B.......|...C....|.........D....|...E
Zeile1: |Produkt-Nr|Testfeld1|Kategoriefeld |Preise
Zeile2: 345345435 |testdata | Artikelbesch |3434
Zeile3: 467578675 |testdata1| Artikelbesch1|4545
Zeile4: 987978435 |testdata2| Artikelbesch1|5364
Zeile5:
Zeile6: |Produkt-Nr|Testfeld2|Kategoriefeld2|Preise
Zeile7: 3453X5435 |testXata | Artikelbesch |4353434
Zeile8: 4675X8675 |testXata1| Artikelbesch1|4543455
Zeile9: 9879X8435 |testXata2| Artikelbesch1|5364354


Es geht dabei um die Zuweisung der Kategorien zu den einzelnen Produkten. Dabei soll der Benutzer in jeder Zeile, wo sich ein Kategoriefeld befindet ein x in Spalte A eintragen. Anschließend soll ein Script ausgeführt werden, dass nachfragt in welcher Spalte sich das Kategoriefeld befindet. Mit diesen gesammelten Infos sollte nun das Skript eine neue Spalte erstellen, in der die jeweiligen Kategorien zu den einzelnen Artikeln eingetragen werden.

Hat jemand von euch dazu eine Idee?

Für Hilfe wäre ich sehr dankbar.

Gruß

Sebastian





1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Kategorien umorganisieren
05.06.2003 09:46:16
Sebastian

Hab nun das Problem folgendermaßen selbst gelöst:

Sub Categories()
Dim rngAct As Range
Dim varFind As Variant, varFindFirst As Variant
Dim lngRowEnd As Long, lngRowAct As Long
Dim lngRowDel As Long
Dim kat
kat = InputBox("In welcher Spalte befindet sich die Kategoriebezeichnung (B=2,C=3,D=4,...)", "Eingabe")

lngRowEnd = Range("B65536").End(xlUp).Row
With ActiveSheet.Columns("A")
Set varFind = .Find(What:="x", After:=Range("A1"), _
SearchDirection:=xlPrevious)
If Not varFind Is Nothing Then
varFindFirst = varFind.Address
Do
For lngRowAct = varFind.Row + 1 To lngRowEnd
Range("C" & lngRowAct) = varFind.Offset(0, kat - 1)
Next lngRowAct
lngRowEnd = varFind.Row - 1
Set varFind = .FindPrevious(varFind)
Loop While Not varFind Is Nothing And _
varFind.Address <> varFindFirst
End If
End With
For lngRowDel = Range("B1").End(xlDown).Row To 2 Step -1
If Range("A" & lngRowDel) = "x" Then
Rows(lngRowDel).Delete
End If
Next lngRowDel

Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

Dim c As Range
Range("A1").Select
Dim Kuerzel
Kuerzel = InputBox("Bitte geben Sie das Herstellerkürzel ein:", "Eingabe")
ActiveSheet.Range("A2:A10000").Select
For Each c In Selection.cells
If c.Value <> "" Then
c.Value = Kuerzel + "-" + WorksheetFunction.Substitute(c.Value, " ", "")
End If
Next

'Nun wird der Index hinzugefügt

letzteZeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Range("C1").Select
ActiveCell.Formula = "Sortierung"
Range("C2").Select
ActiveCell.Formula = "1"

Range("C2", "C" & letzteZeile).Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
Columns("A:A").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit

Range("A1").Select
ActiveCell.Formula = "Artikel-Nr"
Range("B1").Select
ActiveCell.Formula = "Kategorie"

ActiveWorkbook.SaveCopyAs "g:\temp\Preislisten-Generierung\Herstellerliste.xls"


End Sub




Vielleicht hilfts jemanden... =;)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige