Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 14:59:21
23.04.2024 14:47:39
23.04.2024 14:23:45
Anzeige
Archiv - Navigation
1596to1600
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
Inhaltsverzeichnis

Problem mit Select Case Funktion

Problem mit Select Case Funktion
17.12.2017 15:11:37
Rahel
Hallo liebes Forum,
ich habe ein Problem mit der Anwendung der "Select Case" Funktion.
Ich habe eine Tabelle mit Patentdaten - den meisten Patenten sind mehrere IPC Klassen (7 stelliger Code) zugeordnet - diese habe ich bereits auf die Spalten F bis O verteilt und in Spalte P wird angegeben wie viele IPC Klassen dem jeweiligen Patent zugeordnet sind. Nun möchte ich die Patente abhängig von der Anzahl in Spalte P auf die Sheets IPC0 (bei 0 IPC Klassen) bis IPC 10 (bei 10 IPC Klassen) verteilen.
Hierzu habe ich mir mit Hilfe von vielen Beiträgen hier bereits folgenden "Code" gebastelt:
Option Explicit
Sub Test()
Dim i As Integer
Dim ZeileMax As Integer
Dim n As Integer
With Sheets("Patents")
ZeileMax = .UsedRange.Rows.Count
n = 1
For i = 2 To ZeileMax
Select Case Cells(i, 16)
Case 0
.Rows(i).Copy Destination:=Sheets("IPC0").Rows(n)
n = n + 1
Case "1"
.Rows(i).Copy Destination:=Sheets("IPC1").Rows(n)
n = n + 1
Case 2
.Rows(i).Copy Destination:=Sheets("IPC2").Rows(n)
n = n + 1
Case 3
.Rows(i).Copy Destination:=Sheets("IPC3").Rows(n)
n = n + 1
Case 4
.Rows(i).Copy Destination:=Sheets("IPC4").Rows(n)
n = n + 1
Case 5
.Rows(i).Copy Destination:=Sheets("IPC5").Rows(n)
n = n + 1
Case 6
.Rows(i).Copy Destination:=Sheets("IPC6").Rows(n)
n = n + 1
Case 7
.Rows(i).Copy Destination:=Sheets("IPC7").Rows(n)
n = n + 1
Case 8
.Rows(i).Copy Destination:=Sheets("IPC8").Rows(n)
n = n + 1
Case 9
.Rows(i).Copy Destination:=Sheets("IPC9").Rows(n)
n = n + 1
Case Else
.Rows(i).Copy Destination:=Sheets("IPC10").Rows(n)
n = n + 1
End Select
Next
End With
End Sub
Leider funktioniert das überhaupt nicht ... es passiert nichts oder maximal ein Bruchteil von dem was ich möchte. Ich lade die entsprechende Beispieldatei anbei mit hoch und hoffe sehr, dass mir hier jemand einen guten Hinweis geben kann. (Ich habe es bereits mit verschachtelten "If clauses" probiert aber das hat auch nicht recht funktioniert.)
Tausend Danke im Voraus und viele Grüße
Rahel

24
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem mit Select Case Funktion
17.12.2017 15:45:13
Werner
Hallo Rahel,
teste mal:
Sub Test()
Dim i As Long, ZeileMax As Long, loErste As Long
With Sheets("Patents")
ZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To ZeileMax
Select Case Cells(i, 16).Value
Case 0
loErste = Sheets("IPC0").Cells(Sheets("IPC0").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC0").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC0").Rows(loErste)
Case 1
loErste = Sheets("IPC1").Cells(Sheets("IPC1").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC1").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC1").Rows(loErste)
Case 2
loErste = Sheets("IPC2").Cells(Sheets("IPC2").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC2").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC2").Rows(loErste)
Case 3
loErste = Sheets("IPC3").Cells(Sheets("IPC3").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC3").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC3").Rows(loErste)
Case 4
loErste = Sheets("IPC4").Cells(Sheets("IPC4").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC4").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC4").Rows(loErste)
Case 5
loErste = Sheets("IPC5").Cells(Sheets("IPC5").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC5").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC5").Rows(loErste)
Case 6
loErste = Sheets("IPC6").Cells(Sheets("IPC6").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC6").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC6").Rows(loErste)
Case 7
loErste = Sheets("IPC7").Cells(Sheets("IPC7").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC7").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC7").Rows(loErste)
Case 8
loErste = Sheets("IPC8").Cells(Sheets("IPC8").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC8").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC8").Rows(loErste)
Case 9
loErste = Sheets("IPC9").Cells(Sheets("IPC9").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC9").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC9").Rows(loErste)
Case 10
loErste = Sheets("IPC10").Cells(Sheets("IPC10").Rows.Count, 1).End(xlUp).Row + 1
If Sheets("IPC10").Cells(1, 1) = "" Then loErste = 1
.Rows(i).Copy Destination:=Sheets("IPC10").Rows(loErste)
Case Else
End Select
Next i
End With
End Sub
Gruß Werner
Anzeige
AW: Problem mit Select Case Funktion
17.12.2017 15:45:17
Sepp
Hallo Rahel,
dein Problem war die Ermittlung der 'neuen' Zeile im Zielblatt, da hast du nur mit einer Variablen gearbeitet, mann muss aber bei jedem Kopiervorgang die Zielzeile neu ermitteln.
Außerdem habe ich den Code etwas vereinfacht.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Test()
Dim lngIndex As Long, lngLastRow As Long, lngNext As Long
Dim objSheet As Object

With Sheets("Patents")
  lngLastRow = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
  For lngIndex = 2 To lngLastRow
    Select Case .Cells(lngIndex, 16)
      Case 0 To 9
        Set objSheet = SheetExistO("IPC" & .Cells(lngIndex, 16).Text)
        If Not objSheet Is Nothing Then
          lngNext = Application.Max(2, objSheet.Cells(objSheet.Rows.Count, 1).End(xlUp).Row + 1)
          .Rows(lngIndex).Copy Destination:=objSheet.Cells(lngNext, 1)
        End If
      Case Else
        lngNext = Application.Max(2, Sheets("IPC10").Cells(Rows.Count, 1).End(xlUp).Row + 1)
        .Rows(lngIndex).Copy Destination:=Sheets("IPC10").Cells(lngNext, 1)
    End Select
  Next
End With
End Sub

Private Function SheetExistO(ByVal sheetName As String, Optional Wb As Workbook, Optional ByVal byCodeName As Boolean = False) As Object
Dim wks As Object
On Error GoTo ERRORHANDLER
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Sheets
  If byCodeName Then
    If LCase(wks.CodeName) = LCase(sheetName) Then Set SheetExistO = wks: Exit Function
  Else
    If LCase(wks.Name) = LCase(sheetName) Then Set SheetExistO = wks: Exit Function
  End If
Next
ERRORHANDLER:
Set SheetExistO = Nothing
End Function

hier noch die Datei:
https://www.herber.de/bbs/user/118383.xlsm
Gruß Sepp

Anzeige
AW: Problem mit Select Case Funktion
17.12.2017 16:42:27
Rahel
Hallo Sepp, hallo Werner,
vielen Dank für eure Ideen. Beide Codes bringen mich schon sehr viel weiter als der Versuch von mir. Leider ist es jedoch in beiden Fällen so, dass sich in allen 11 Sheets (IPC0 - IPC10) auch andere Patentzeilen als die jeweils zugeordneten einschleichen. (So finden sich im IPC10 sheet bspw auch Patente mit 2, 3 oder 5 IPC Klassen - dieser Fehler tritt auf allen Sheets auf). Und ich habe überhaupt keine Idee woran das liegen könnte.
Ich wäre euch dankbar, wenn ihr hierzu nochmal Input habt. (Es macht glaube ich keinen Sinn nochmal ein Beispiel Excel hochzuladen.)
Herzlichen Dank
Rahel
Anzeige
AW: Problem mit Select Case Funktion
17.12.2017 17:12:17
Werner
Hallo Rahel,
kann ich so nicht navollziehen und auch nicht bestätigen. Zumindest bei deiner hochgeladenen Datei macht der Code (hab jetzt nur mal meinen laufen lassen) genau das was er soll. Es sind keine falschen Daten in den einzelnen Blättern.
Was mir aber gerade noch aufgefallen ist.
Hier:
Select Case Cells(i, 16).Value
fehlt vor dem Cells ein Punkt.
Müßte so aussehen:
Select .Case Cells(i, 16).Value
Gruß Werner
Quark mit Soße...
17.12.2017 17:39:27
Werner
Hallo Rahel,
der Punkt gehört natürlich nicht vor das Case sondern vor das Cells
Select Case .Cells(i, 16).Value
Gruß Werner
Anzeige
AW: Quark mit Soße...
17.12.2017 17:48:02
Rahel
Danke für den Hinweis! Leider ändert das auch nichts an dem Problem, dass bei mir viele Zeilen den falschen Blättern zugeordnet werden (siehe dazu die eben hochgeladene Datei)
Danke und viele Grüße
Rahel
AW: Quark mit Soße...
17.12.2017 17:53:53
Werner
Hallo Rahel,
deine neue Datei kann ich mir leider nicht anschauen, kann hier im Moment leider keine .xlsm herunterladen.
Wie ich schon geschrieben habe, kann ich das mit deiner zuerst hier hochgeladenen Datei nicht nachvollziehen.
Im Blatt IPC0 befinden sich nur Datensätze die im Blatt Patents in Spalte P eine 0 als Eintrag haben. Im Blatt IPC1 nur solche, die im Blatt Patents in Spalte P eine 1 als Eintrag haben. Das gleiche gilt für alle anderen IPC Blätter auch.
Gruß Werner
Anzeige
AW: Quark mit Soße...
17.12.2017 18:23:22
Rahel
Hallo Werner,
ich habe es jetzt nochmal neu probiert und plötzlich funktioniert es bestens - VIELEN HERZLICHEN DANK! Und entschuldige bitte die unnötige Verwirrung, ich habe keine Ahnung was vorher das Problem war.
Eine schöne Vorweihnachtszeit und vielleicht bis bald zu einer anderen Frage
Rahel
Gerne u. Danke für die Rückmeldung. o.w.T.
17.12.2017 18:24:12
Werner
AW: Problem mit Select Case Funktion
17.12.2017 17:44:29
Rahel
Hallo Werner,
danke für deine schnelle Rückmeldung.
Ich habe deinen Code auch auf das von mir hochgeladene Excel angewendet aber es zeigt mir immer noch in den verschiedenen Sheets Zeilen an, die dort nicht hineingehören ... ich kann es mir auch überhaupt nicht erklären.
Ich habe die Beispieldatei nochmal gekürzt und mit angewandtem Makro hochgeladen:
https://www.herber.de/bbs/user/118386.xlsm
Wenn ich vor Case einen Punkt setze beschwert sich das Programm, deswegen habe ich daraufhin weiterhin verzichtet.
Herzlichen Dank
Rahel
Anzeige
AW: Problem mit Select Case Funktion
17.12.2017 17:47:33
onur
Wenn du vielleicht auch mal meine Frage beantworten könntest, könnte ich evtl. mithelfen.
AW: Problem mit Select Case Funktion
17.12.2017 18:03:24
onur
Dann eben nicht.
Dann noch viel Glück!
AW: Problem mit Select Case Funktion
17.12.2017 18:21:01
Rahel
Lieber Onur,
vielen Dank für deine Bereitschaft ebenfalls zu helfen - ich war völlig beschäftigt den Input von Werner und Sepp zu verarbeiten. Jetzt hat es gepasst und alles funktioniert. Ich habe allerdings den Verdacht, dass weitere Fragen aufkommen können und da würde ich mich natürlich riesig freuen, wenn du dabei dann unterstützen kannst!
Danke dennoch und eine schöne Vorweihnachtszeit
Rahel
AW: Problem mit Select Case Funktion
17.12.2017 17:48:44
Sepp
Hallo Rahel,
noch immer nicht nachvollziehbar!
https://www.herber.de/bbs/user/118387.xlsm
Gruß Sepp

Anzeige
AW: Problem mit Select Case Funktion
17.12.2017 18:19:26
Rahel
Hallo Werner,
ich habe es jetzt nochmal mit deinem Code probiert und plötzlich funktioniert es bestens - VIELEN HERZLICHEN DANK! Und entschuldigt bitte die unnötige Verwirrung, ich habe keine Ahnung was vorher das Problem war.
Eine schöne Vorweihnachtszeit und vielleicht bis bald zu einer anderen Frage
Rahel
AW: Problem mit Select Case Funktion
17.12.2017 18:22:40
Rahel
Sepp meine ich natürlich, jetzt komme ich hier schon völlig mit den Namen und Threads durcheinander!!!
Danke nochmal!
AW: Problem mit Select Case Funktion
17.12.2017 17:18:28
Sepp
Hallo Rahel,
kann ich auch nicht nachvollziehen, in deiner Beispieldatei werden alle richtig zugeordnet.
Gruß Sepp

Anzeige
AW: Problem mit Select Case Funktion
17.12.2017 17:20:42
onur
Verstehe ich richtig: Wenn ein Datensatz einen IPC1-Eintrag und einen IPC2-Eintrag hat,soll er auf Blatt IPC1 UND in Blatt IPC2 kopiert werden? Wenn ja - was ist mit Blatt IPC0?
Oder hängt es wirklich nur von der ANZAHL der IPC-Einträge ab? Wenn ja, dann sind aber die Blattnamen irreführend bzw nicht eindeutig.
AW: Mal nebenbei, das ist keine VBA-Funktion, ...
17.12.2017 18:24:29
Rahel
Hallo Luc,
haha ich kenne mich wirklich nicht besonders gut aus - von daher hast du wahrscheinlich recht.
Was ist Switch und wie würde ich das in diesem konkreten Fall anwenden?
Vielen Dank für den Hinweis
Rahel
Switch
17.12.2017 18:52:49
Nepumuk
Hallo Rahel,
das frage ich mich auch. Hier ein Beispiel aus einer Mappe von mir:
objCell.Interior.Color = Switch(pvvntLetter = "U", vbGreen, _
    pvvntLetter = "F", vbYellow, IsEmpty(pvvntLetter), vbWhite)

Gruß
Nepumuk
AW: Switch
17.12.2017 19:20:52
Rahel
Danke! Darunter kann ich mir ehrlich gesagt nichts vorstellen ... und ich hätte keine Ahnung wie ich es auf meinen Fall anwende, aber der ist ja zum Glück gelöst ;-)
Vll. erklärt Luc ja noch, wie man das anwenden würde !
In deinem Fall würde ich das wohl nicht ...
17.12.2017 22:43:14
Luc:-?
…anwenden, Rahel,
denn das ist eine echte vbFkt, bei der kein Teil einen Fehler ergeben darf, sonst ergibt sie auch insgesamt einen Fehler. Das ist bei Ablaufsteuerungskonstrukten idR nicht der Fall.
Den VBEditor kennst du doch sicher‽ Der hat auch eine Hilfe, in der du nach Switch fragen könntest…
Ansonsten gings mir hier nur um exakte Begriffe, was in Mathematik und Informatik (also auch Pro­gram­mie­rung) wichtig ist. Funktion (function) ist in VBA (u. eigentl auch Xl) iaR im mathe­matisch-technischen Sinn zu verstehen.
Luc :-?

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige