Microsoft Excel

Herbers Excel/VBA-Archiv

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

Zell wert auslesen

Betrifft: Zell wert auslesen von: Monika
Geschrieben am: 17.09.2004 19:56:44

Hallo zusammen,

ich steh vor folgendem Problem:

ich habe in EINER Spalte verschiedene Inhalte in Zellen die eine Mehrfachbedeutung haben z.Bsp.

24K 18X 42G
46X 46G
8U 32X 40G
40X 40G
40X 40G

nun muss die die Anzahl der Zahlenwerte je Kategorie ermittelt werden.
also 208 G; 176 X; 8 U; 24 K;

hat jemand nen Lösungsansatz für mich - ich komm einfach nicht voran.

Dank im voraus
Monika

  


Betrifft: AW: Zell wert auslesen von: Nepumuk
Geschrieben am: 17.09.2004 22:58:13

Hallo Monika,
da du nicht schreibst, wo sich die Einträge befinden und was mit dem Ergebnis geschehen soll, mal ein Beispielcode der von Spalte A ab Zeile 1 ausgeht und die Ergebnisse in einer MsgBox anzeigt:


Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32" (pArray() As Any) As Long

Public Sub Monika()
    Dim bolFound As Boolean
    Dim intIndex As Integer, intStart As Integer
    Dim lngRow As Long, lngIndex As Long
    Dim strTemp As String
    Dim strArray() As String
    Dim dblArray() As Double
    For lngRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        intStart = 1
        For intIndex = 1 To Len(Cells(lngRow, 1))
            If Mid(Cells(lngRow, 1), intIndex, 1) = " " Or intIndex = Len(Cells(lngRow, 1)) Then
                strTemp = Mid(Cells(lngRow, 1), intStart, intIndex - intStart + 1 * ((intIndex = Len(Cells(lngRow, 1))) * -1))
                If SafeArrayGetDim(strArray()) Then
                    For lngIndex = 1 To UBound(strArray)
                        If strArray(lngIndex) = Right$(strTemp, 1) Then bolFound = TrueExit For
                    Next
                Else
                    ReDim Preserve strArray(1 To 1)
                    ReDim Preserve dblArray(1 To 1)
                    strArray(UBound(strArray)) = Right$(strTemp, 1)
                    lngIndex = 1
                    bolFound = True
                End If
                If bolFound Then
                    dblArray(lngIndex) = dblArray(lngIndex) + Val(strTemp)
                    bolFound = False
                Else
                    ReDim Preserve strArray(1 To UBound(strArray) + 1)
                    ReDim Preserve dblArray(1 To UBound(dblArray) + 1)
                    strArray(UBound(strArray)) = Right$(strTemp, 1)
                    dblArray(UBound(dblArray)) = Val(strTemp)
                End If
                intStart = intIndex + 1
            End If
        Next
    Next
    For lngIndex = 1 To UBound(strArray)
        MsgBox CStr(dblArray(lngIndex)) & " " & strArray(lngIndex)
    Next
End Sub


Gruß
Nepumuk


  


Betrifft: AW: Zell wert auslesen von: Monika
Geschrieben am: 20.09.2004 13:43:19

Hallo Nepomuk,

danke für die super Antwort. Hätt ich allein nicht hinbekommen. wie schaffe ich dein Makro so zu ändern, das die Ergebnisse in eine neues tabellenblatt in in eine Zeile nebeneinander geschrieben wird. Muss ich einfach nur MSG box mit einem copy Befehl ersetzen ?

Viele Grüße
Moni


  


Betrifft: AW: Zell wert auslesen von: Nepumuk
Geschrieben am: 20.09.2004 16:03:22

Hallo Monika,
die Daten liegen in zwei Arrays vor. Du kannst eine direkte Zuweisung der Werte vornehmen. Soll die Ausgabe immer in der selben Zeile / Spalte erfolgen, oder wie hast du dir das gedacht?
Gruß
Nepumuk


  


Betrifft: AW: Zell wert auslesen von: Monika
Geschrieben am: 20.09.2004 16:16:02

Hallo Nepomuk,

also Ergbniss 1 soll in A1; Ergebniss 2 in B1 usw. gespeichert werden.
Ich versuch jetzt mal Excel dazu zu bringen diese Arrays zu speichern ;o)

Gruß

Monika


  


Betrifft: AW: Zell wert auslesen von: Nepumuk
Geschrieben am: 20.09.2004 16:28:42

Hallo Monika,
ich habe das Programm noch etwas geändert. Du musst in den zwei gekennzeichneten Zeilen nur noch die Tabellennamen noch anpassen.


Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32" (pArray() As Any) As Long

Public Sub Monika()
    Dim bolFound As Boolean
    Dim intIndex As Integer, intStart As Integer
    Dim lngRow As Long, lngIndex As Long
    Dim strTemp As String
    Dim strArray() As String
    Dim dblArray() As Double
    With Worksheets("Tabelle1") 'Tabelle1 = Eingabetabelle
        For lngRow = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
            intStart = 1
            For intIndex = 1 To Len(.Cells(lngRow, 1))
                If Mid(.Cells(lngRow, 1), intIndex, 1) = " " Or intIndex = Len(.Cells(lngRow, 1)) Then
                    strTemp = Mid(.Cells(lngRow, 1), intStart, intIndex - intStart + 1 * ((intIndex = Len(.Cells(lngRow, 1))) * -1))
                    If SafeArrayGetDim(strArray()) Then
                        For lngIndex = 1 To UBound(strArray)
                            If strArray(lngIndex) = Right$(strTemp, 1) Then bolFound = TrueExit For
                        Next
                    Else
                        ReDim Preserve strArray(1 To 1)
                        ReDim Preserve dblArray(1 To 1)
                        strArray(UBound(strArray)) = Right$(strTemp, 1)
                        lngIndex = 1
                        bolFound = True
                    End If
                    If bolFound Then
                        dblArray(lngIndex) = dblArray(lngIndex) + Val(strTemp)
                        bolFound = False
                    Else
                        ReDim Preserve strArray(1 To UBound(strArray) + 1)
                        ReDim Preserve dblArray(1 To UBound(dblArray) + 1)
                        strArray(UBound(strArray)) = Right$(strTemp, 1)
                        dblArray(UBound(dblArray)) = Val(strTemp)
                    End If
                    intStart = intIndex + 1
                End If
            Next
        Next
    End With
    If SafeArrayGetDim(strArray()) Then
        For lngIndex = 1 To UBound(strArray)
            Worksheets("Tabelle2").Cells(1, lngIndex) = CStr(dblArray(lngIndex)) & " " & strArray(lngIndex) ' Tabelle2 = Ausgabetabelle
        Next
    End If
End Sub


Gruß
Nepumuk


  


Betrifft: AW: Zell wert auslesen von: Monika
Geschrieben am: 20.09.2004 17:01:01

Hallo Nepomuk,

nochmals vielen Dank für die super Hilfe, alleine hätt ich das nicht hinbekommen.
Ich hoffe ich bekomm das in naher Zukunft mal auf die Reihe mich intensiver mit VBA
zu befassen.

Gruß bis bald Moni


  


Betrifft: AW: Zell wert auslesen von: Monika
Geschrieben am: 20.09.2004 17:10:33

Hallo Nepomuk,

eine kleine Frage hab ich noch (versuche ja zu lernen)
habe gerade mit deinem Code experimentiert. Mir ist es gelungen das ergebniss in eine beliebige Zeile zu speichern. Jetzt wollte ich noch die Quell Spalte ändern. Also das dieses Markro halt Spalte B oder C bearbeitet. Leider kann ich im VBA Code keinen Hinweis auf die Spalte finden. Müsste das nicht irgendwiw mit Col (column) oder so gekennzeichnet sein? ich find nur diese Zeile wo du schreibst das er jede Zeile in dieser Spalte bearbeiten soll. Oder ?? (For lngRow = 1 To .Cells(Rows.Count, 1).End(xlUp).Row)


  


Betrifft: AW: Zell wert auslesen von: Nepumuk
Geschrieben am: 21.09.2004 05:22:44

Hallo Monika,
entscheident ist das Cells - Objekt. Syntax: Cells(Zeilennummer,Spaltennummer)
Gruß
Nepumuk


  


Betrifft: AW: Zell wert auslesen von: Monika
Geschrieben am: 21.09.2004 15:50:14

Hallo Nepomuk,

;o( hab schon wieder ein Problemchen mit den Zellwerten. Ich habe nicht bedacht,
es auch folgende Werte vorhanden sind: 1,5X leider zählt dein Makro nur die Vollen Zahlen. Kann man das noch irgendwie ändern?

Gruß Monika


  


Betrifft: AW: Zell wert auslesen von: Monika
Geschrieben am: 21.09.2004 17:15:46

Lösung:

habe einfach die Kommas durch Punkt ersetzen lassen und schon funzt es.

Gruß Moni


 

Beiträge aus den Excel-Beispielen zum Thema "Zell wert auslesen "