PDA

Vollständige Version anzeigen : Nach Zelle anklicken, Tabellenvergleich


th.sel
09.07.2014, 09:34
Hallo Zusammen,

Ich habe kaum eine Ahnung von der Programmierung von VBA unter Excel 2003.

Ich möchte nun folgende Aufgabe lösen:

In einer Exeltabelle mit zwei Tabellenblättern möchte ich nach anklicken einer Zelle, den Wert dieser anzeigen lassen, und dann diesen Wert in Tabelle zwei vergleichen und passende Werte anzeigen lassen.
In der ersten Tabelle befinden sich Artikelnummern mit dazugehörenden Daten, in der zweiten Tabelle befinden sich dieselben Artikelnummern mit unterschiedlichsten Lagerplätzen.
1. Schritt:
Wenn ich eine Zelle in Tabelle1 anklicke, soll der die Artikelnummer angezeigt werden.
2. Schritt:
Die Artikelnummer mit den Artikelnummern in Tabelle2 vergleichen und alle Lagerplätze anzeigen.
Ist das möglich ??

Viele Grüße
Thomas

Mc Santa
09.07.2014, 09:54
Hallo,

Schritt 1 ist mir ein wenig unklar: Klicke ich auf eine Zelle mit Artikelnummer, oder auf eine beliebige Zelle?

Schritt 2 ist auf jeden Fall machbar, wenn man die Artikelnummer weiß, bitte lade eine Beispieldatei hoch, dann ist eine Lösung einfacher zu erstellen.

VG

Hajo_Zi
09.07.2014, 09:57
Hallo Thomas,

Du hast in Deinem Beitrag Extra keine Datei verlink bzw. einen Tabellen Ausschnitt (nicht als Bild) dargestellt. Da Du die vorgeschlagene Lösung selbst auf Deine Bedingungen anpassen wollest. Also viel Erfolg, ich habe ja schon eine Lösung erstellt. Warum sollte ich noch eine zweite erstellen.

starte den VBA Editor (Alt+F11), Bild sollte zweigeteilt sein ansonsten Strg+R, Doppelklick auf Deine Datei, Doppelklick auf Deine Tabelle, Code ins rechte Fenster kopieren, VBA Editor schließen.
Das Makro wird automatisch gestartet.
Der Code wirkt nur in dieser Tabelle.
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RaRange As Range
Dim StFundst
If Target.Column = 1 Then
MsgBox " Artikel " & Target
With Worksheets("Tabelle17").Columns(1)
Set RaRange = .Find(Target, , xlValues, xlWhole, , xlNext)
If Not RaRange Is Nothing Then
StFundst = RaRange.Address
Do
MsgBox "Lagerplatz " & RaRange.Offset(0, 1)
Set RaRange = .FindNext(RaRange)
Loop While Not RaRange Is Nothing And RaRange.Address <> StFundst
End If
End With
End If
End Sub


<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

th.sel
09.07.2014, 12:18
Hallo Hajo,

vielen dank für die schnelle Antwort. Funktioniert einwandfrei.
Ist es möglich die Lagerplätze alle in einer MsgBox anzuzeigen?

mfG
Thomas

th.sel
09.07.2014, 12:28
Hallo Hajo,

vielen dank für die schnelle Antwort. Funktioniert einwandfrei.
Ist es möglich die Lagerplätze alle in einer MsgBox anzuzeigen?

mfG
Thomas

Hajo_Zi
09.07.2014, 12:49
Hallo Thomas,

vor Do
Dim StMeldung As String
StMeldung = "Lagerplatz "

für msgbox
StMeldung = StMeldung & RaRange.Offset(0, 1) & ", "

nach Loop
If StMeldung <> "Lagerplatz " Then
MsgBox Left(StMeldung, Len(StMeldung) - 2)
End If

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

th.sel
10.07.2014, 06:38
hallo Hajo

Nach Änderung ging gar nichts mehr. Fehler End With ohne With, oder End If ohne If Block.
Bei folgenden Code gings in eine Endlosschleife.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RaRange As Range
Dim StFundst
If Target.Column = 2 Then
MsgBox " Artikel " & Target
With Worksheets("Tabelle2").Columns(2)
Set RaRange = .Find(Target, , xlValues, xlWhole, , xlNext)
If Not RaRange Is Nothing Then
StFundst = RaRange.Address
Dim StMeldung As String
StMeldung = "Lagerplatz "
Do
StMeldung = StMeldung & RaRange.Offset(0, 4) & ", "
Set RaRange = .FindNext(RaRange)
Loop
If StMeldung <> "Lagerplatz " Then
MsgBox Left(StMeldung, Len(StMeldung) - 2)
End If
End If
End With
End If
End Sub


mfG
Thomas

Hajo_Zi
10.07.2014, 08:55
Hallo Thomas,

Ich baue keine Datei nach, die Zeit hat schon jemand investiert.
Ein Nachbau sieht bestimmt anders aus als das Original.
Ein Link zur Datei oder ein Tabellen Ausschnitt nicht als Bild wäre nicht schlecht.
<br/><b><em>Jul 2014</em></b><table border="1" cellspacing="0" cellpadding="0" style="border-color:#000000; border-width: 1px; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "><colgroup><col style="font-weight:bold; width:40px;" /><col style="width:209px;" /></colgroup><tr style="background-color:#99CCFF; text-align:center; font-weight:bold; "><td>&nbsp;</td><td>C</td></tr><tr><td style="background-color:#99CCFF; text-align:center; font-weight:bold; ">29</td><td style="border-color:#000000; color:#000000; border-color:#000000; background-color:#FFFFFF ;; text-align:right; ">Falsch</td></tr><tr><td style="background-color:#99CCFF; text-align:center; font-weight:bold; ">30</td><td style="border-color:#000000; color:#000000; border-color:#000000; background-color:#FFFFFF ;; text-align:right; ">496</td></tr></table><br/><table border="1" cellspacing="0" cellpadding="0" style="border-color:#000000; border-width: 1px;font-size:11pt; background-color:#ffffff; width:800px;padding-left:2pt; padding-right:2pt; "><tr style="background-color:#FFCC66; text-align:center; font-weight:bold; "><td colspan="3" > verwendete Formeln </td><td> </td></tr><tr valign="top" style="background-color:#FFCC66; text-align:center; font-weight:bold; "><td> Zelle </td><td> Formel</td><td> Bereich </td> <td>N/A</td></tr><tr><td>C29</td><td>=C27=C28</td><td>&nbsp;</td><td>&nbsp;</td></tr><tr><td>C30</td><td>=SUMMEWENN([Bildschirm.xlsm]Statistik!$Q$44:$Q$54;"&lt;" &amp;HEUTE();[Bildschirm.xlsm]Statistik!$R$54)</td><td>&nbsp;</td><td>&nbsp;</td></tr></table><table cellspacing="0" cellpadding="0"><tr style="text-align:left; font-weight:bold; " class="style21"><td style="text-align:left; font-size: xx-small" ><a href="http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip" >Excel-Inn.de</a></td></tr> <tr style="text-align:left; font-weight:bold; " class="style21"><td style="text-align:left; font-size: xx-small" ><a href='http://Hajo-Excel.de/tools.htm' >Hajo-Excel.de</a></td></tr><tr style="text-align:left; font-weight:bold;" ><td style="text-align:left; font-size: xx-small" >XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007</td></tr><tr style="text-align:left; font-weight:bold; " ><td style="text-align:left; font-size: xx-small" > Add-In-Version 18.07 einschl. 64 Bit</td></tr></table><br/>
Benutze hier im Forum die Funktion zum hochladen. Falls Du die nicht benutzen möchtest beachte, von unsicheren Servern wie z.B. www.file-upload.net lade ich keine Datei runter. (lt. Einschätzung meines Virenprogramms)
Der Dateiname sollte was mit dem Problem zu tun haben.
Ich habe mir z.B. einen Ordner angelegt in dem ich alle Dateien aus dem Internet speichere. Bei Dateinamen wie Test..., Mappe…, Beispiel… wird eine vorhandene überschrieben.
Schaue hier, Dateiname im Beitrag (http://www.ms-office-forum.net/forum/showthread.php?t=58538&highlight=Beitrags-Nr#3)
das ist nun das Word -Forum, das gilt hier aber auch.
<b>Ein Bild in Excel geöffnet sieht anders aus als das Bild.</b>

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

th.sel
10.07.2014, 09:45
Hallo Hajo

habe nicht allzu viele Erfahrung mit solchen Foren.
Hoffe der Anhang hilft etwas.
Der Code funktioniert einwandfrei, es wäre nur besser wenn alle Lagerplätze in einer Msg-Box
Stehen würden.

mfG
Thomas

Mc Santa
10.07.2014, 09:51
Hallo,

nach dem Vorbild von Hajo's Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RaRange As Range
Dim StFundst
If Target.Column = 2 Then
MsgBox " Artikel " & Target
With Worksheets("Tabelle2").Columns(2)
Set RaRange = .Find(Target, , xlValues, xlWhole, , xlNext)
If Not RaRange Is Nothing Then
StFundst = RaRange.Address
Dim StMeldung As String
StMeldung = "Lagerplatz "
Do
StMeldung = StMeldung & RaRange.Offset(0, 4) & ", "
Set RaRange = .FindNext(RaRange)
Loop While Not RaRange Is Nothing And RaRange.Address <> StFundst
If StMeldung <> "Lagerplatz " Then
MsgBox Left(StMeldung, Len(StMeldung) - 2)
End If
End If
End With
End If
End Sub

Funktioniert es so?
VG

th.sel
11.07.2014, 13:41
Hallo Mc Santa

Funktioniert soweit sehr gut. Besteht die Möglichkeit das der Code nur bei nicht leerern Zellen greift.

mfG

Thomas