Teilnehmerfragen zu VBA

Notiz

Vorausgesetzt wird, das Tabelle1 und Tabelle2 in den ersten beiden Spalten Namen-Wert-Paare enthalten.

Tabelle 3 soll dann alle Namen, die in beiden Tabellen vorkommen, zusammen mit ihren beiden Werten, enthalten.

Dim Liste As New Collection
Public Function IsIn(c As Collection, k As String) As Boolean
  'ist ${k} in ${c}?
  Dim v As Variant
  Dim e As Long
  IsIn = False
  Set v = Nothing
  Err.Clear
  On Error Resume Next
    v = c.Item(k)
    n = CLng(Err.Number)
  On Error GoTo 0
  If n = 5 Then
    IsIn = False
  Else
    IsIn = True
  End If
End Function
Function Num(name As String) As Integer
  'Wie viele Zeilen sind im Blatt ${name} belegt?
  Dim R1 As Range
  Set R1 = Sheets(name).Cells(1, 1)
  Dim R2 As Range
  Set R2 = Range(R1, R1.End(xlDown))
  Let Num = R2.Row + R2.Rows.Count - 1
End Function
Sub Makro3()
  ' Füge Wert und Zeilennummer jeder belegten Zeile aus Tabelle1 zur Liste hinzu
  Dim name As String
  For R = 1 To Num( "Tabelle1" )
    name = Sheets( "Tabelle1" ).Cells( R, 1 )
    Liste.Add key:=name, Item:=R
  Next R
  ' Falls der Name aus Tabelle2 in der Liste gefunden wird, dann schreibe
  ' in, zusammen mit seinen Werten aus Tabelle1 und Tabelle2 in Tabelle3
  Dim I As Integer
  Z = 1
  For R = 1 To Num( "Tabelle2" )
    name = Sheets( "Tabelle2" ).Cells( R, 1 )
    If IsIn( Liste, name ) Then
        Sheets("Tabelle3").Cells(Z, 1) = name
        Sheets("Tabelle3").Cells(Z, 2) = Sheets("Tabelle1").Cells(Liste.Item(name), 2)
        Sheets("Tabelle3").Cells(Z, 3) = Sheets("Tabelle2").Cells(R, 2)
        Z = Z + 1
      Else
    End If
  Next R
End Sub
2013-11-05T20:18:06+02:00

Notiz

Variante der obigen Notiz mit erweiterter Berechnung in Tabelle3

Dim Liste As New Collection
Dim Liste1 As New Collection
Public Function IsIn(c As Collection, k As String) As Boolean
  Dim v As Variant
  Dim e As Long
  IsIn = False
  Set v = Nothing
  Err.Clear
  On Error Resume Next
    v = c.Item(k)
    n = CLng(Err.Number)
  On Error GoTo 0
  If n = 5 Then
    IsIn = False
  Else
    IsIn = True
  End If
End Function
Function Num(name As String) As Integer
  Dim R1 As Range
  Set R1 = Sheets(name).Cells(1, 1)
  Dim R2 As Range
  Set R2 = Range(R1, R1.End(xlDown))
  Let Num = R2.Row + R2.Rows.Count - 1
End Function
Sub Makro3()
    Dim name As String
  For R = 1 To Num("Tabelle1")
    name = Sheets("Tabelle1").Cells(R, 1)
    Liste.Add Key:=name, Item:=R
  Next R
  Dim I As Integer
  Z = 1
  Dim Summe As Integer
  Summe = 0
  For R = 1 To Num("Tabelle2")
    name = Sheets("Tabelle2").Cells(R, 1)
    If IsIn(Liste, name) Then
        Liste1.Add Key:=name, Item:=1
        Sheets("Tabelle3").Cells(Z, 1) = name
        w = Sheets("Tabelle1").Cells(Liste.Item(name), 2) + Sheets("Tabelle2").Cells(R, 2)
        Sheets("Tabelle3").Cells(Z, 2) = w
        Summe = Summe + w
        Z = Z + 1
      Else
    End If
  Next R
  For R = 1 To Num("Tabelle1")
.    name = Sheets("Tabelle1").Cells(R, 1)
    Debug.Print name
    Debug.Print IsIn(Liste1, name)
    If Not IsIn(Liste1, name) Then
      Sheets("Tabelle3").Cells(Z, 1) = name
      w = Sheets("Tabelle1").Cells(R, 2)
      Sheets("Tabelle3").Cells(Z, 2) = w
        Summe = Summe + w
      Z = Z + 1
    End If
  Next R
  For R = 1 To Num("Tabelle2")
    name = Sheets("Tabelle2").Cells(R, 1)
    Debug.Print name
    Debug.Print IsIn(Liste1, name)
    If Not IsIn(Liste1, name) Then
      Sheets("Tabelle3").Cells(Z, 1) = name
      w = Sheets("Tabelle2").Cells(R, 2)
      Sheets("Tabelle3").Cells(Z, 2) = w
      Summe = Summe + w
      Z = Z + 1
    End If
  Next R
  Cells(Z, 1) = "Summe"
  Cells(Z, 2) = Summe
End Sub
2013-11-05T21:22:20+02:00

Notiz

Wie kann man Kurse aus dem Internet abfragen?

Zeigt Kursabfrage

Dim HTMLdoc As HTMLDocument 'Microsoft HTML Object Library
Dim ie As InternetExplorer ' Microsoft Internet Controls
Sub Main()
Set ie = CreateObject("internetexplorer.application")
ie.Visible = False
ie.navigate "http://de.finance.yahoo.com/q?s=gcz13.cmx"
Do
  DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set HTMLdoc = ie.document
Debug.Print HTMLdoc.getElementById("yfs_l10_gcz13.cmx").innerText
ie.Quit
End Sub

Notiz

Zeigt Verwendung von ArrayList (Collection)

Sub a()
Dim MyCollection As New Collection
MyCollection.Add Item:="myValue", Key:="myKey"
MsgBox (MyCollection.Item("myKey"))
End Sub

Notiz

Zeigt Verwendung von HashMap (Dictionary)

2013-10

Wie kann man Numeralia mit unterschiedlicher Zahl von Vor- und Nachkommastellen an ihrem Komma untereinander ausrichten?

2012-10

Wie kann man Leerzeilen in einer Excel-Tabelle löschen? (Problem: Wann soll eine Zeile als leer gelten?)

Sub Makro1()
  Dim FirstLine As Long
  Dim LastLine As Long
  Dim Line As Long
  Dim L As Long
  Const EndLine = 1048576
  Range("A1").Select
  If IsEmpty(Selection.Value) Then Selection.End(xlDown).Select
  If Selection.Row = EndLine Then
    Debug.Print "Leere Spalte."
  Else
    FirstLine = Selection.Row
    Do While Selection.Row < EndLine
      LastLine = Selection.Row
      Selection.End(xlDown).Select
    Loop
    Debug.Print FirstLine
    Debug.Print LastLine
    L = FirstLine
    For Line = FirstLine To LastLine
      Debug.Print "L = " & L
      If IsEmpty(Cells(L, 1)) Then
        Rows(L).Delete Shift:=xlUp
        Debug.Print "L : " & L
      Else
        L = L + 1
      End If
    Next Line
  End If
End Sub

Wie kann man eine Formel nach einer Benutzereingabe in einem Dialog erstellen?

Private Sub CommandButton1_Click()
  Let Endzeile = Range("C2").End(xlDown).Row
  For Zeile = 2 To Endzeile
    Range("D" & Zeile).Formula = _
    "=" & Me.TextBox2 & Zeile & _
    "-" & Me.TextBox3 & Zeile
  Next Zeile
  Me.Hide
End Sub

Wie kann man zwischen Groß- und Kleinschreibung wandeln?

Ein Makro vom Sonntag, dem 2006-05-21T16:30

Eine bestimmte Zahl von Zeilen vom unteren Ende einer Tabelle als Diagramm darstellen

Modul1

Sub Makro1()
  Let Delta = InputBox("Wie viele Zeilen von unten?")
  Let LastRow = Range("A1").End(xlDown).Row
  Let FirstRow = LastRow - Delta + 1
  Charts.Add
  ActiveChart.ChartType = xlXYScatter
  ActiveChart.SetSourceData _
  Source:=Sheets("Tabelle1").Range("A" & FirstRow & ":B" & LastRow)
  ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle1"
End Sub

Ergänzungen zu VBA

Command execution

result = Shell( "C:\WINDOWS\CALC.EXE ", vbMinimizedNoFocus

C-Programme aufrufen

C-Programme aufrufen

result = Shell( "C:\WINDOWS\CALC.EXE ", vbMinimizedNoFocus )

Definition in C

long _stdcall testlib(long const x) { return x << 1; }

Eintrag in .def-Datei

EXPORTS testlib

Nicht vergessen die neu erzeugte .dll nach C:\WINDOWS zu kopieren!

Deklaration in Access:

Private Declare Function testlib Lib "testdll" Alias "_testlib@4" (ByVal intN As Long) As Long

Aufruf in Access:

r = testlib(x)

Weitere Themen von 2005-12-11

Ausgabe von XHTML (XML)
Einbinden eines OCX aus der VB control creation edition
Einfügen eines Microsoft Web Browser OCX in eine UserForm (mit einem Benutzerfunktion)
Excel Tabellen-Makro OnChange: In Entwurfsmodus zum Arbeiten mit der Ablage
Range.end(XlDown)

andere Programme aufrufen

siehe auch: VB-Kurs

Null

(Null = Null) is False

Optimierung

Optimieren: nicht Variant, nicht Mid/left/right, sondern mid$/left$/right$

Mehrerer Variablen in einer Deklaration

Vorsicht! Ohne expliziten Typ bei jedem Eintrag, gilt er als Variant

Decimal

Nur als Subtype von Variant wie CDec

Alle Typen
Alle numerischen Typen

Datentyp: Currency, Date, Decimal, fixed-length String

Details von String-Literalen
Details von Bezeichner

auch Buchstaben nichtenglischer Sprachen

Numerik
String-Repräsentations-Details

Unicode, Null-Character

the End Statement
Versionsnummern
Neuerungen

721648 jf — Excel-VBA-FAQ
Fragestunde

Dauerhafte Speicherung (schon in zwei Veranstaltungen gefragt)

Wie können Makrodaten über mehrere Makroaufrufe hinweg gespeichert werden?

SaveSetting, GetSetting

Datenbank

OPEN, PRINT#, INPUT#, CLOSE

C-Programme aufrufen

C-Programme aufrufen

result = Shell( "C:\WINDOWS\CALC.EXE ", vbMinimizedNoFocus )

Definition in C

long _stdcall testlib(long const x) { return x << 1; }

Eintrag in .def-Datei

EXPORTS testlib

Nicht vergessen die neu erzeugte .dll nach C:\WINDOWS zu kopieren!

Deklaration in Access:

Private Declare Function testlib Lib "testdll" Alias "_testlib@4" (ByVal intN As Long) As Long

Aufruf in Access:

r = testlib(x)

String an einer bestimmten Stelle zerlegen

Access Datensätze nach mehreren Kriterien: Firma Opel, Baujahr 80, Farbe rot: Abfrage definieren (kann man auch von VBA ansprechen/definieren)
SELECT Tabelle1.Baujahr, Tabelle1.Firma, Tabelle1.Farbe FROM Tabelle1 WHERE (((Tabelle1.Baujahr)<1990) AND ((Tabelle1.Farbe)="gruen"))
Access Cursor in bestimmtes Formularfeld in bestimmtem Bereich eines Formulars
VBA Taschenrechner in Webseite einbetten
Word Zoom
Access Heutiges Datum in Datenblattformular
Access Von Excel aus starten
Access Datensatz löschen (innerhalb eines Formulars)
VBA MsgBox-Optionen

Teilnehmerfragen zu VBA

Notiz

Notiz

Notiz

Notiz

Notiz

2013-10

2012-10

Wie kann man Leerzeilen in einer Excel-Tabelle löschen? (Problem: Wann soll eine Zeile als leer gelten?)

Ein Makro vom Sonntag, dem 2006-05-21T16:30

Ergänzungen zu VBA

Command execution

C-Programme aufrufen

andere Programme aufrufen

Null

Optimierung

Mehrerer Variablen in einer Deklaration

Decimal

Alle TypenAlle numerischen Typen

Details von String-LiteralenDetails von Bezeichner

NumerikString-Repräsentations-Details

the End StatementVersionsnummernNeuerungen

721648 jf — Excel-VBA-FAQFragestunde

Dauerhafte Speicherung (schon in zwei Veranstaltungen gefragt)

C-Programme aufrufen

String an einer bestimmten Stelle zerlegen

Alle Typen
Alle numerischen Typen

Details von String-Literalen
Details von Bezeichner

Numerik
String-Repräsentations-Details

the End Statement
Versionsnummern
Neuerungen

721648 jf — Excel-VBA-FAQ
Fragestunde