Thema Datum  Von Nutzer Rating
Antwort
06.05.2013 19:06:04 Oliver
NotSolved
07.05.2013 13:41:39 Gast43639
NotSolved
07.05.2013 18:15:23 Gast87766
NotSolved
08.05.2013 19:32:58 Gast86147
NotSolved
08.05.2013 19:37:27 Gast96452
NotSolved
Blau Transport-Matrix erstellen VBA
 08.05.2013 20:33:45 Gast82200
NotSolved

Ansicht des Beitrags:
Von:
Gast82200		 Datum:
08.05.2013 20:33:45		 Views:
1799		 Rating:
     
Antwort:
  Ja
Thema:
Transport-Matrix erstellen VBA

Hab jetzt mal so programmiert wie ich mirs dachte.

Sub test()
  
  Dim dicX(1 To 2)  As Scripting.Dictionary 'einzubinden über: VBA-Menü -> Extras -> Verweise -> 'Microsoft Scripting Runtime'
  Dim rngData       As Excel.Range
  Dim rngResult     As Excel.Range
  Dim strFA         As String
  Dim i&, j&
  
  With Tabelle1.UsedRange
    Set rngData = .Resize(.Rows.Count - 1).Offset(1)
  End With
  
  For i = 1 To 2
    
    'initialisieren
    Set dicX(i) = CreateObject("Scripting.Dictionary")
    
    'suche in Spalte nach Ausdruck 'X'
    Set rngResult = rngData.Columns(i).Find("X", LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not rngResult Is Nothing Then
      strFA = rngResult.Address
      Do
        
        If Not dicX(i).Exists(rngResult.Offset(ColumnOffset:=Choose(i, 1, -1)).Text) Then
          'neuen Eintrag tätigen
          dicX(i).Add rngResult.Offset(ColumnOffset:=Choose(i, 1, -1)).Text, 1
        Else
          'Eintrag bereits vorhanden... (ist was zu tun?)
        End If
        
        'suche nächsten Ausdruck in Spalte
        Set rngResult = rngData.Columns(i).FindNext(rngResult)
        
      Loop While rngResult.Address <> strFA
    End If
    
  Next i
  
  'Ausgabe (vorerst nur) als Text
  '(wenn 'Direktbereich'-Fenster nicht sichtbar: STRG + G)
  For i = 0 To dicX(2).Count - 1
    For j = 0 To dicX(1).Count - 1
      Debug.Print dicX(2).Keys(j) & "/" & dicX(1).Keys(i)
    Next
  Next
  
  Set rngResult = Nothing
  Set rngData = Nothing
  
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
06.05.2013 19:06:04 Oliver
NotSolved
07.05.2013 13:41:39 Gast43639
NotSolved
07.05.2013 18:15:23 Gast87766
NotSolved
08.05.2013 19:32:58 Gast86147
NotSolved
08.05.2013 19:37:27 Gast96452
NotSolved
Blau Transport-Matrix erstellen VBA
 08.05.2013 20:33:45 Gast82200
NotSolved