Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

@ Mullit

Betrifft: @ Mullit von: Spenski
Geschrieben am: 06.08.2014 18:27:05

Hallo Mullit :)

Es geht um folgenden thread , leider finde ich nicht heraus wie ich aufs archive zugreifen bzw verlinken kann...klappt irgendwie nicht.

Alle tabellenblätter nach zelleninhalt durchsuchen von Spenski vom 25.07.2014 21:34:56

Das Programm, wo unteranderem auch dein code verwendet wird ist heute in die testphase gestartet.
Leider buggt er an einer stelle.

der code:

Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
ByRef pArray() As Any) As Long

Public Sub test()
Const START_ROW As Long = 2
Const START_COLUMN As Long = 3
Dim blnInit As Boolean
Dim strFirstAddress As String
Dim ialngCount As Long, ialngIndex As Long
Dim lngIncr As Long
Dim avntArray() As Variant
Dim objRange As Range
Dim wksSheet As Worksheet
With Worksheets("Daten")
    For ialngIndex = START_ROW To .Cells(.Rows.Count, 1).End(xlUp).Row
       If .Cells(ialngIndex, 1) <> vbNullString Then
         ialngCount = 0
         lngIncr = 0
         For Each wksSheet In Worksheets
            If wksSheet.CodeName <> .CodeName Then
              Set objRange = wksSheet.Columns(3).Find(What:=.Cells(ialngIndex, 1), _
                After:=wksSheet.Cells(wksSheet.Cells(wksSheet.Rows.Count, 3).End(xlUp).Row, 3),  _
_
                LookIn:=xlValues, LookAt:=xlWhole)
              If Not objRange Is Nothing Then
                 strFirstAddress = objRange.Address
                 Do
                    ialngCount = ialngCount + 1
                    If blnInit Then
                      If Ubound(avntArray, 2) < ialngCount + lngIncr Then _
                        Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                          ialngCount * 2) As Variant
                    Else
                      Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                        ialngCount * 2) As Variant
                    End If
                    avntArray(ialngIndex - START_ROW, 0) = ialngCount
                    avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, _
 -2)
                    lngIncr = lngIncr + 1
                    avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, _
 -1)
                    Set objRange = wksSheet.Columns(3).FindNext(After:=objRange)
                 Loop While Not objRange Is Nothing And objRange.Address <> strFirstAddress
              End If
            End If
         Next
         If Not blnInit Then blnInit = Not blnInit
       End If
    Next
    If .Cells(.Rows.Count, 1).End(xlUp).Row < .UsedRange.Rows.Count + 1 Then _
      .Range(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, START_COLUMN), _
         .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).ClearContents
    If CBool(SafeArrayGetDim(avntArray)) Then
      If 1 + Ubound(avntArray, 2) < .UsedRange.Columns.Count Then _
        Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
           .UsedRange.Columns.Count) As Variant
      .Range(.Cells(START_ROW, START_COLUMN), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
        START_COLUMN + Ubound(avntArray, 2))) = avntArray
    Else
      MsgBox "Keine Daten zur Überprüfung vorhanden!", vbExclamation
    End If
End With
Set objRange = Nothing
End Sub
Im Fett markierten wird ein Fehler gemeldet (hab den zettel auf der arbeit vergessen , wie der fehler heisst)

Der Fehler tritt aber nur auf wenn bei dem ersten Zelleninhalt in "Daten" kein eintrag in den anderen tabellenblättern gefunden wird.

findet er den ersten eintrag läuft das makro wunderbar und ohne probleme.

hab jetzt erstmal einen FAKE eintrag gemacht damit der erste eintrag 100% gefunden wird

hast du eine idee???

gruss
christian

  

Betrifft: AW: @ Spenski von: robert
Geschrieben am: 06.08.2014 18:46:00

Hi,
schau mal da nach

https://www.herber.de/users.html

Gruß
robert


  

Betrifft: @ Robert :) von: Spenski
Geschrieben am: 06.08.2014 18:50:01

hi

Ja wie ich ins archive komme weiss ich aber mir wird kein link angezeigt... in der URL steht bei mir immer https://www.herber.de/forum/

gruss


  

Betrifft: AW: @ Robert :) von: Mullit
Geschrieben am: 06.08.2014 20:41:05

Hallo Christian,

ist nicht nötig, bin schon da...
ja böse Falle , die boolsche Abfrage muß zwei If-Anw. höher gesetzt werden...
Hab' noch für den Fall, daß keine Vergleichsdaten gefunden werden, eine Meldung eingebaut...

Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
    ByRef pArray() As Any) As Long

Public Sub test()
Const START_ROW As Long = 2
Const START_COLUMN As Long = 3
Dim blnInit As Boolean
Dim strFirstAddress As String
Dim ialngCount As Long, ialngIndex As Long
Dim lngIncr As Long
Dim avntArray() As Variant
Dim objRange As Range
Dim wksSheet As Worksheet
With Worksheets("Daten")
    For ialngIndex = START_ROW To .Cells(.Rows.Count, 1).End(xlUp).Row
       If .Cells(ialngIndex, 1) <> vbNullString Then
         ialngCount = 0
         lngIncr = 0
         For Each wksSheet In Worksheets
            If wksSheet.CodeName <> .CodeName Then
              Set objRange = wksSheet.Columns(3).Find(What:=.Cells(ialngIndex, 1), _
                After:=wksSheet.Cells(wksSheet.Cells(wksSheet.Rows.Count, 3).End(xlUp).Row, 3), _
                LookIn:=xlValues, LookAt:=xlWhole)
              If Not objRange Is Nothing Then
                 strFirstAddress = objRange.Address
                 Do
                    ialngCount = ialngCount + 1
                    If blnInit Then
                      If Ubound(avntArray, 2) < ialngCount + lngIncr Then _
                        Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                          ialngCount * 2) As Variant
                    Else
                      Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
                        ialngCount * 2) As Variant
                    End If
                    avntArray(ialngIndex - START_ROW, 0) = ialngCount
                    avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, -2)
                    lngIncr = lngIncr + 1
                    avntArray(ialngIndex - START_ROW, ialngCount + lngIncr) = objRange.Offset(0, -1)
                    Set objRange = wksSheet.Columns(3).FindNext(After:=objRange)
                 Loop While Not objRange Is Nothing And objRange.Address <> strFirstAddress
                 If Not blnInit Then blnInit = Not blnInit
              End If
            End If
         Next
       End If
    Next
    If .Cells(.Rows.Count, 1).End(xlUp).Row < .UsedRange.Rows.Count + 1 Then _
      .Range(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, START_COLUMN), _
         .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).ClearContents
    If CBool(SafeArrayGetDim(avntArray)) Then
      If 1 + Ubound(avntArray, 2) < .UsedRange.Columns.Count Then _
        Redim Preserve avntArray(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, _
           .UsedRange.Columns.Count) As Variant
      .Range(.Cells(START_ROW, START_COLUMN), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
        START_COLUMN + Ubound(avntArray, 2))) = avntArray
    ElseIf .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
      .Range(.Cells(START_ROW, START_COLUMN), _
        .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).ClearContents
      MsgBox "Es konnten keine Vergleichsdaten zur Überprüfung gefunden werden!", vbExclamation
    Else
      MsgBox "Keine Daten zur Überprüfung vorhanden!", vbExclamation
    End If
End With
Set objRange = Nothing
End Sub




VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 12

Gruß, Mullit


  

Betrifft: AW: @ Robert :) von: Spenski
Geschrieben am: 06.08.2014 21:06:13

danke Mullit ... das ist so nett .

die beiden msgboxn kann ich ja ohne weiteres rausnehmen oder?

gruss und einen schönen abend

christian


  

Betrifft: AW: @ Robert :) von: Mullit
Geschrieben am: 06.08.2014 21:35:42

Hallo Christian,

klar kein Problem, ich dachte die wären als Bestätigung ganz hilfreich, wenn keine Werte übernommen werden...

Gruß Mullit,


  

Betrifft: danke von: Spenski
Geschrieben am: 06.08.2014 21:42:21

ne ist nicht nötig... nach dem code laufen noch ca 20secunden ein anderer code , würde den vorgang nur unterbrechen :) die durch deinen code ausgelesenen daten werden zum schluss nochmal untereinander verglichen und ausgewertet.

klappt alles wunderbar dank dir. kanns zwar nicht zuhause testen da ich nur die 64bit version auf meinen privat laptop hab aber das wird morgen auf der arbeit schon passen :D

dank dir

gruss
christian


  

Betrifft: AW: danke von: Mullit
Geschrieben am: 06.08.2014 22:28:01

Hallo Christian,

sollte mit Bedingter Kompilierung auf beiden Office-Versionen laufen:

Option Explicit

#If VBA7 Then
   Private Declare Ptrsafe Function SafeArrayGetDim Lib "oleaut32.dll" ( _
       ByRef pArray() As Any) As Long
#Else
   Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
       ByRef pArray() As Any) As Long
#End If

'...

Gruß Mullit,


  

Betrifft: AW: danke von: Spenski
Geschrieben am: 06.08.2014 22:38:50

danke


  

Betrifft: leider noch ein problem von: Spenski
Geschrieben am: 07.08.2014 14:44:21

Hallo Mullit.
es taucht in diesem teil Laufzeitfehler 1004 auf (Kann Teil einer verbundenen Zeile nicht ändern.
Ich kann leider nicht ausschliessen, dass es an der datei und dem aufbau liegt (hochladen ist ein wenig schwer weil 9MB gross und mit bezüge auf massig verschiedener Pfade.
Der code funktioniert aber wenn ich die IF abfrage rausnehme.
Meine Frage wäre also erstmal was dieser Teil des Codes prüft evtl find ich den fehler dann selber.

gruss

End If
End If
Next
End If
Next
If .Cells(.Rows.Count, 1).End(xlUp).Row < .UsedRange.Rows.Count + 1 Then _
.Range(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, START_COLUMN), _
.Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).ClearContents


  

Betrifft: AW: leider noch ein problem von: Mullit
Geschrieben am: 07.08.2014 22:01:57

Hallo,

Kann Teil einer verbundenen Zeile nicht ändern.

ja das liegt an der Datei, Du hast da Vebundzellen eingebaut, da wirft der Code den Fehler..

Der Code ist zum Löschen der Zeilen mit alten gefunden Daten, wenn die Anzahl neuer gefundener Daten kleiner ist als die Anzahl der alten Daten...

Bei Tests auf XL 2007 mit Verbundzellen erhalte ich bisher keinen Fehler, das unterschiedl. Verhalten könnte aber an Deiner Dateistruktur oder Excelversion liegen.
Mit XL 2010 müsste ich's nochmal testen...

Du könntest die Verbundzellen aufheben, aber für eine Lösung mit Verbundzellen müsstest Du schon eine Bsp.-Datei mit den BeispielSuchDaten und dem relevanten Vebundzellenbereich hochladen,
Alles andere kannst Du ja entfernen oder anonymisieren...

Gruß,


  

Betrifft: AW: leider noch ein problem von: Spenski
Geschrieben am: 07.08.2014 22:47:54

Werd morgen mal eine Bsp Datei nachbauen...denke auch das es zu 100% an meiner Datei liegt.

Zu den verbundzellen. Ich habe nur in zeile 1 verbundzeilen in der Datei in der die Zu suchenden Werte stehen.

Aber suchen tut das Makro ja erst ab zeile 2.

Ich werd morgen einfach mal die verbundzellen entfernen. Hatte Bissl stress die Idee kam mir gar nicht :)


Gruss


  

Betrifft: AW: leider noch ein problem von: Spenski
Geschrieben am: 08.08.2014 14:18:12

So Fehler gefunden....in Spalte AZ waren zellen verbunden.....warum auch immer.

Das Ding läuft ich danke dir :)


Zur Verständnis : vor dem Code lösche ich eh alle alles in "Control" ab zeile 2 und lese die zu suchenden Daten neu ein. Das macht den Teil um den es jetzt gerade Gin eigentlich überflüssig oder??


Gruß und ein tolles Wochenende
Christian


  

Betrifft: AW: leider noch ein problem von: Mullit
Geschrieben am: 08.08.2014 20:32:19

Hallo Christian,

prima;

ja, kann dann raus....

Gruß, Mullit