Steuerung der Anzeige einer Textbox durch Zeilenauswahl

[sotaros]

Hallo Andre,
sehe gerade Deinen Code und werde den morgen ausprobieren. Danke.

Anbei aber auch meine "Stümmelleistung" einen beliebigen Satz in der TextBox1 zu markieren:

Code:

Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)
Dim a As Integer
Dim u As Variant
Dim vbstr As String

u = Split(TextBox1.Value, vbLf)
vbstr = ""

For a = 0 To TextBox1.CurLine - 1
vbstr = vbstr & u(a)
Next a

With TextBox1
.SelStart = Len(vbstr)
.SelLength = Len(u(TextBox1.CurLine))
End With

End Sub

Hab meinen Code kurz ausprobiert und er funktioniert.

[schauan]

Hallo sotaros,

ist ja im Grundprinzip dasselbe. Ich schaue nur meistens, dass ich ohne oder mit möglichst wenigen Schleifen auskomme. Deswegen splitte ich zwei mal - beim zweiten mal den gesamten Text anhand des kompletten Inhaltes der angeklickten Zeile. Dafür hab ich dann das Problem mit der Eindeutigkeit, was bei Deinem Code egal ist

[pefeu]

Hallo sataros,

angenommen, Deine Werte stehen in Tabelle1 in Spalte A und Spalte B ab Zeile 1.
Es gibt eine TextBox1 mit den 10 Einträgen und eine zweite TextBox2 für das Ergebnis.

Dann könnte das hier funktionieren

PHP-Code:

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim vTemp         As Variant
Dim iIndx         As Integer
Dim sText         As String
Dim sSuchbegriff  As String
 
   vTemp = Split(TextBox1.Value, vbLf)
   sText = Replace(TextBox1.Value, vbLf, "")
   If TextBox1.SelStart = 0 Then
      sSuchbegriff = sText
    Else
      sSuchbegriff = Mid(sText, TextBox1.SelStart)
   End If
   
   TextBox2.Value = ""
   
   For iIndx = 0 To UBound(vTemp)
      sText = Left(sSuchbegriff, Len(vTemp(iIndx)))
      If CStr(vTemp(iIndx)) = CStr(sText) Then
         TextBox2.Value = ThisWorkbook.Worksheets("Tabelle1").Range("B" & iIndx + 1)
         Exit Sub
      End If
   Next iIndx

End Sub 


Gruß Peter

[Kuwer]

Hallo Peter,

nett, aber auch knapp an der "Aufgabenstellung", die ListBoxen ja verbietet, vorbei! ;)

Wähle ich jetzt weiter Zeile 2 aus Textbox1 aus, steht in Textbox2 der Inhalt von Zelle B2, natürlich wieder in der Höhe von Zeile 2 aus Textbox1.

In der TextBox2 steht der zugehörige Wert der Spalte B immer oben! ;)

Gruß Uwe

[atilla]

Hallo sotaros,

nach dem ich zwei alte Folgen Columbo genossen habe, konnte ich eine Lösung erarbeiten.

Wenn ich alles richtig verstanden habe, dann hast Du schon die meiste Arbeit gemacht, nur kurz vorm Ziel ist Dir die Puste ausgegangen. Was da noch an Code kommt, ist nicht mehr viel:

Code:

Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)
   Dim a As Integer
   Dim u As Variant
   Dim vbstr As String
   Dim strT As String
   u = Split(TextBox1.Value, vbLf)
   vbstr = ""
  
   For a = 0 To TextBox1.CurLine - 1
      vbstr = vbstr & u(a)
   Next a
  
   With TextBox1
      .SelStart = Len(vbstr)
      .SelLength = Len(u(TextBox1.CurLine))
      For a = 1 To .CurLine - 1
         strT = strT & vbCrLf
      Next a
      TextBox2.Text = strT & Cells(.CurLine, 2)
   End With

End Sub

Und hier eine Beispiel in einer Musterdatei:

  Text_Textbox_Markierung.xlsm (Größe: 18,08 KB / Downloads: 4)

[schauan]

Hallo Sotaros,

ich nehme an, dass Du die fehlende Zeile(n) in meinem code zum Eintrag des Begriffes aus Spalte B selbst hinbekommen hast? Wenn die Begriffe in Spalte A und der Textbox1 gleicher Reihenfolge stehen dann reicht eine Zeile

Code:

'zugehoerigen Text aus Spalte B in Textbox2 eintragen
TextBox2 = Cells(TextBox1.CurLine + 1, 2)

Falls nicht, werden es auch nicht mehr Zeilen - Kommentare ausgenommen . Ich würde hier wieder auf eine Schleife verzichten und mit Find arbeiten.

Code:

'Uebernahme des Eintrags aus Spalte B neben dem betreffenden Eintrag in Spalte A.
'Hinweis: Zur Suche Arrayinhalt um Zeichen 13 kuerzen!
TextBox2 = Cells(Columns(1).Find(what:=Replace(arrZeilen(TextBox1.CurLine), Chr(13), ""), lookat:=xlWhole).Row, 2)

Ich habe die anderen codes jetzt nur gelesen und nicht getestet. Ich vermute aber, dass es beim Splitten mit vblf und dem folgenden Vergleich mit den Zellinhalten Probleme geben kann, weil nach dem Splitten noch das Zeichen 13 am Text im Array hängt.

Atilla hat glaube nicht immer berücksichtigt, dass die Zählung von CurLine mit 0 beginnt. Die zweite Schleife beginnt mit 1 statt mit 0, und das mit dem + 1 fehlt und dürfte bei Auswahl von Zeile 1 zu einem Fehler führen und bei den Folgezeilen eine zu tief sein.


Das mit der Eindeutigkeit in meinem Beitrag möchte ich dahingehend kommentieren dass ich keine doppelten Einträge meinte. Frau und Frauenquote funktioniert natürlich, auch wenn "Frau" dann je nach Betrachtungsweise nicht mehr eindeutig ist.

[atilla]

Hallo zusammen,

die zweite Schleife ist natürlich überflüssig. Das kann man in der ersten gleich mit einarbeiten.

So geht es auch:

Code:

Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)
   Dim a As Integer
   Dim u As Variant
   Dim vbstr As String
   Dim strT As String
   u = Split(TextBox1.Value, vbCrLf)
   vbstr = ""
  
   For a = 0 To TextBox1.CurLine - 1
      vbstr = vbstr & u(a)
      strT = strT & vbCrLf
   Next a
  
   With TextBox1
      .SelStart = Len(vbstr) + a
      .SelLength = Len(u(TextBox1.CurLine))
      TextBox2.Text = strT & Cells(.CurLine + 1, 2)
   End With

End Sub

Hallo Andre,

wenn Du richtig liegst mit Deinen Ausführungen, dann habe ich die Aufgabenstellung falsch verstanden.

So verstehe ich es:
Textbox1 ist befüllt und hat 10 Zeilen.
Textbox2 ist leer und ist genau so groß wie Textbox1 und Textbox2.Top = Textbox1.Top

sotaro klickt in Textbox1 und eine Zeile wird markiert. Nehmen wir an, es ist die Zeile 3.
Jetzt soll in Textbox2 der Wert aus Zeile 3 der Spalte B geschrieben werden. Der Wert soll
in Textbox2 auch in Zeile 3 der Textbox erscheinen.

Frage an sotaros: Habe ich das so richtig verstanden?

[schauan]

Hallo Atilla,
das siehst Du ziemlich richtig. Die Textbox2 soll sukzessive mit den "gewählten" Daten aus Spalte B befüllt werden. Allerdings wird bei Mehrfachauswahl nicht mehr nachgefüllt sondern einfach nur markiert, sonst würden dort ja die anderen Einträge verschoben.
Man könnte für den Fall die zweite Textbox auch schon füllen mit weißem Text auf weißem Grund und färbt dann die jeweilige Zeile.

[atilla]

Hallo Andre,

so ein Mist, da habe ich einen wesentlichen Satz übersehen.

Das steht im ersten Posting von sotaros:

Code:

Der Inhalt von zuvor in der Textbox2 erschienenen Inhalten soll aber dabei selbstverständlich nicht verschwinden

Dann mal weiter werkeln.
Könnte mir vorstellen, dass die Tag Eigenschaft zum Ablegen der bisher eingelesenen Werte nütlizch sein kann. Schaun mer mal.

[schauan]

Hallo zusammen,

hier jetzt der weiterentwickelte code auf meinem Weg. Hinweis: die zweite Textbox muss zuvor auf Multiline und gleiche Größe gestellt werden, der code nimmt darauf keinen Bezug. Ich habe die beiden vorangehenden Varianten noch drin. Ausführung wie gehabt ohne Schleife. Kommentarbereinigt 8 Zeilen code (ohne Sub / End Sub),

Code:

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Variablendeklaration
'Variant-Array
Dim arrZeilen1, arrZeilen2
'Text der textboxen 1 und 2 anhand der Zeilenenden splitten
arrZeilen1 = Split(TextBox1, vbLf)
arrZeilen2 = Split(TextBox2, vbLf)
'Array fuer Textbox2 auf 10 Elemente setzen.
'Falls in der textbox2 10 Leerzeilen enthalten sind, ist das nicht noetig!
ReDim Preserve arrZeilen2(0 To 9)
'Start der Markierung berechnen, Trennung hier anhand erstem Auftreten des textes der angeklickten Zeile
TextBox1.SelStart = Len(Split(TextBox1, arrZeilen1(TextBox1.CurLine))(0)) - TextBox1.CurLine
'Länge anhand der Textlänge der angeklickten Zeile
TextBox1.SelLength = Len(arrZeilen1(TextBox1.CurLine))
'Hinweis: Die Markierung wird nur dann exakt gesetzt, wenn der Text der Zeile in der Box nicht doppelt vorkommt.
'************ Variante 1 **************
'zugehoerigen Text aus Spalte B in Textbox2 eintragen
'TextBox2 = Cells(TextBox1.CurLine + 1, 2)
'oder
'************ Variante 2 **************
'Uebernahme des Eintrags aus Spalte B neben dem betreffenden Eintrag in Spalte A.
'Hinweis: Zur Suche Arrayinhalt um Zeichen 13 kuerzen!
'TextBox2 = Cells(Columns(1).Find(what:=Replace(arrZeilen1(TextBox1.CurLine), Chr(13), ""), lookat:=xlWhole).Row, 2)
'************ Variante 3 **************
'Uebernahme des Eintrages aus Spalte B neben dem Eintrag aus Spalte A in das Array fuer Textbox2
arrZeilen2(TextBox1.CurLine) = Cells(Columns(1).Find(what:=Replace(arrZeilen1(TextBox1.CurLine), Chr(13), ""), lookat:=xlWhole).Row, 2)
'Uebernahme des Array in textbox2 mit Zeillentrenner vblf
TextBox2 = Join(arrZeilen2, vbLf)
End Sub