VBA-Wörter Suchen und Bereich als Tabelle formatieren

[Terades]

Hallo zusammen,

Und zwar hab ich eine ganz flexibel aussehende Tabelle, bei der ich Schlagwörter habe bei denen aus dem "anliegenden Bereich" eine "Tabelle" erstellt werden soll...

Im Prinzip als wenn ich von Hand das Wort anklicke und dann Strg+A drücke, dann wird ja der separierte Bereich markiert und dann als Tabelle Formatieren klicke.

Test aaaa aaaa
bbbb bbbb bbbb

Test2 aaaa bbbb cccc
dddd ssss ffff gggg
eeee wwww eeee rrrr

Test3 aaaa bbbb cccc
dddd ssss ffff gggg
eeee wwww eeee rrrr
dddd ssss ffff gggg
eeee wwww eeee rrrr

Die sollten jeweils zu Tabellen formatiert werden, 1. Zeile jeweils die Überschriften.

Also es soll nach Test gesucht werden > (Strg + a immitieren) > Tabelle

Test2 suchen > (Strg + a immitieren) >  Tabelle

Test3 suchen > (Strg + a immitieren) > Tabelle

Habt ihr sowas auf der art schonmal gemacht?

(Ebenfalls auf Herber gepostet, da aber irgendwie verhauen)

Vielen dank schonmal.

:)

[Elex]

Hi

Teste ob der Code den Zweck erfüllt. Es wird nicht nach Wörtern gesucht sondern nach zusammenhängenden Bereichen. In deiner Bsp.Datei klappt das so.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Zelle As Variant
Dim rngA As Range
Dim rngB As Range

For Each Zelle In Range("A1:A10000").SpecialCells(xlCellTypeConstants)
  Set rngB = Zelle.CurrentRegion
  If rngA Is Nothing Then
     Set rngA = rngB
  Else
    Set rngA = Application.Union(rngA, rngB)
  End If
Next Zelle

For Each Zelle In rngA.Areas
 ActiveSheet.ListObjects.Add(xlSrcRange, Zelle, , xlYes).Name = "Tabelle" & ActiveSheet.ListObjects.Count + 1
Next Zelle
End Sub

Gruß Elex

[snb]

Code:

Sub M_snb()
    For Each it In Sheet1.Cells.SpecialCells(2).Areas
         Sheet1.ListObjects.Add 1, it, , 1
    Next
End Sub