Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
744to748
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
744to748
744to748
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA Lösung bitte gesucht

VBA Lösung bitte gesucht
16.03.2006 11:12:11
Josef
Hallo!
mit nachfolgendem Code werden die in den Textboxen 2-16 angezeigten Werte ab der dritten spalte in das aktive Tabellenblatt eingetragen.
Wo und wie müßte ich bitte den Code dahingehend ändern, wenn ich erreichen will, dass der Wert in den Textboxen 2,7 und 12 nicht in das Tabellenblatt eingetragen werden soll?
Danke
Josef
If Nametxt1.Text = usertxt1 And _
Label72.Caption = "Hauskrankenpflege über 4 Wochen" And _
Label78.Caption = "Heilbehelfe und Hilfsmittel" And _
Label84.Caption = "KH - Aufnahmeanzeigen" Then
Dim rngFind As Range
Dim intCount As Integer, intCol As Integer, lngRow As Long
If Not IsDate(datumtxt1) Then Exit Sub
'With Sheets("Tabelle1")
With ActiveSheet
'Set rngFind = .Range("B:B").Find(what:=CDbl(TextBox1), LookAt:=xlWhole, LookIn:=xlValues)
'Set rngFind = .Range("B:B").Find(what:=CDate(TextBox1), LookAt:=xlWhole, LookIn:=xlValues)
Set rngFind = .Range("B:B").Find(What:=CDate(datumtxt1), LookAt:=xlWhole, LookIn:=xlFormulas)
If Not rngFind Is Nothing Then
lngRow = rngFind.Row
intCol = 3
For intCount = 2 To 16
Select Case intCount
Case 2 To 16
If Len(Trim$(Controls("TextBox" & intCount))) &gt 0 Then
If IsNumeric(Controls("TextBox" & intCount)) Then
.Cells(lngRow, intCol) = CDbl(Controls("TextBox" & intCount))
Else
.Cells(lngRow, intCol) = Controls("TextBox" & intCount)
End If
End If
intCol = intCol + 1
Case Else
lngRow = lngRow + 1
intCol = 3
End Select
Next
End If
Set rngFind = Nothing
End With
Else
'Hain
If Nametxt2.Text = usertxt1

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Lösung bitte gesucht
16.03.2006 11:15:59
Reinhard
Hi Josef,
schreib mal ganze Subs oder setze <pre> vor den Code und </pre> nach den Code, dann kann man ihn auch lesen.
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
AW: VBA Lösung bitte gesucht
16.03.2006 11:29:46
Josef
Hallo Reinhard!
hier ist das ganze mit Sub

Private Sub Speichern_A()
If Nametxt1.Text = usertxt1 And _
Label72.Caption = "Hauskrankenpflege über 4 Wochen" And _
Label78.Caption = "Heilbehelfe und Hilfsmittel" And _
Label84.Caption = "KH - Aufnahmeanzeigen" Then
Dim rngFind As Range
Dim intCount As Integer, intCol As Integer, lngRow As Long
If Not IsDate(datumtxt1) Then Exit Sub
'With Sheets("Tabelle1")
With ActiveSheet
'Set rngFind = .Range("B:B").Find(what:=CDbl(TextBox1), LookAt:=xlWhole, LookIn:=xlValues)
'Set rngFind = .Range("B:B").Find(what:=CDate(TextBox1), LookAt:=xlWhole, LookIn:=xlValues)
Set rngFind = .Range("B:B").Find(What:=CDate(datumtxt1), LookAt:=xlWhole, LookIn:=xlFormulas)
If Not rngFind Is Nothing Then
lngRow = rngFind.Row
intCol = 3
For intCount = 2 To 16
Select Case intCount
Case 2 To 16
If Len(Trim$(Controls("TextBox" & intCount))) > 0 Then
If IsNumeric(Controls("TextBox" & intCount)) Then
.Cells(lngRow, intCol) = CDbl(Controls("TextBox" & intCount))
Else
.Cells(lngRow, intCol) = Controls("TextBox" & intCount)
End If
End If
intCol = intCol + 1
Case Else
lngRow = lngRow + 1
intCol = 3
End Select
Next
End If
Set rngFind = Nothing
End With
End Sub

Josef
Anzeige
AW: VBA Lösung bitte gesucht
16.03.2006 11:40:02
Reinhard
Hi Josef,
Private Sub Speichern_A()
If Nametxt1.Text = usertxt1 And _
Label72.Caption = "Hauskrankenpflege über 4 Wochen" And _
Label78.Caption = "Heilbehelfe und Hilfsmittel" And _
Label84.Caption = "KH - Aufnahmeanzeigen" Then
Dim rngFind As Range
Dim intCount As Integer, intCol As Integer, lngRow As Long
If Not IsDate(datumtxt1) Then Exit Sub
'With Sheets("Tabelle1")
With ActiveSheet
'Set rngFind = .Range("B:B").Find(what:=CDbl(TextBox1), LookAt:=xlWhole, LookIn:=xlValues)
'Set rngFind = .Range("B:B").Find(what:=CDate(TextBox1), LookAt:=xlWhole, LookIn:=xlValues)
Set rngFind = .Range("B:B").Find(What:=CDate(datumtxt1), LookAt:=xlWhole, LookIn:=xlFormulas)
If Not rngFind Is Nothing Then
lngRow = rngFind.Row
intCol = 3
For intCount = 3 To 16
Select Case intCount
Case 7, 12
Case Else
If Len(Trim$(Controls("TextBox" & intCount))) > 0 Then
If IsNumeric(Controls("TextBox" & intCount)) Then
.Cells(lngRow, intCol) = CDbl(Controls("TextBox" & intCount))
Else
.Cells(lngRow, intCol) = Controls("TextBox" & intCount)
End If
End If
intCol = intCol + 1
End Select
Next
End If
Set rngFind = Nothing
End With
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
AW: VBA Lösung bitte gesucht
16.03.2006 12:07:31
Josef
Hallo Reinhard!
Danke für Deine Antwort und Deine Lösung.
Eine Frage noch:
Statt intCol = 3 müßte ich jetzt intCol = 4 setzen da ja die Textbox2 ausgelassen wird oder liege ich da falsch?
Josef
AW: VBA Lösung bitte gesucht
16.03.2006 12:32:38
Reinhard
Hi Josef,
das kann ich nicht wissen, du legst doch damit fest ab welcher Spalte eingetragen werden soll.
Gruß
Reinhard
AW: VBA Lösung bitte gesucht
17.03.2006 18:37:00
Josef
Hallo Reinhard!
Jetzt passt alles.Danke für alles
Josef

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige