Select entfernen?

Bild

Betrifft: Select entfernen?
von: Thomas
Geschrieben am: 02.10.2015 21:27:56

Hallo excelfreunde,
ich bekomme wieder mal das select nicht weg.
Kann jemand Helfen das select zu entfernen?
Super wäre auch wenn ich an dieser stelle eine

GroupBy:=1
variable einsetzen könnte bei
GroupBy:=quellueberschrift
kommt leider methode des rangobjekt kann nicht ausgeführt werden.
kennt jemand eine lösung?
liebe grüsse thomas

Sub teilergebnis()
'
Dim zielueberschrift As String
quellueberschrift = "Namen"
Spesenspalte = "Spesen"
ArbeitsTabelle = "tabelle1"
 Dim ueberschriftzeile As Long, Namenspalte As Long, letztegefüllte As Long, erstewertzeile As   _
_
Long
 Dim spaltespesen
 '#############quelle ##########
 ueberschriftzeile = Sheets(ArbeitsTabelle).Cells.Find(quellueberschrift).Row
 Namenspalte = Rows(ueberschriftzeile).Find(quellueberschrift, LookAt:=xlWhole).Column
 
spaltespesen = Rows(ueberschriftzeile).Find(Spesenspalte, LookAt:=xlWhole).Column
'
    'Range("a1").Select
    erstewertzeile = ThisWorkbook.Worksheets(ArbeitsTabelle).Cells(ueberschriftzeile,  _
Namenspalte).Select
    
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(spaltespesen), _
    Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    Selection.ClearOutline
   letztegefüllte = Sheets(ArbeitsTabelle).Cells(Rows.Count, Namenspalte).End(xlUp).Offset(0, 0) _
 _
.Row
   
    
    'x = letztegefüllte
    For i = ueberschriftzeile To letztegefüllte                       '  hier stand mal 1 to x
    Rows(i).Select
    If Cells(i, Namenspalte).Value Like "*Ergebnis*" Then
    Selection.Font.Bold = True
    End If
    Next
End Sub

Bild

Betrifft: AW: Select entfernen?
von: Sepp
Geschrieben am: 03.10.2015 01:08:22
Hallo Thomas,
natürlich ungetestet!

Sub teilergebnis()
Dim lngUeberschriftRow As Long, lngLastRow As Long, lngFirstRow As Long
Dim lngSpesenCol As Long, lngNameCol As Long, lngI As Long
Dim strQuellueberschrift As String, strSpesen As String, strTabelle As String

strQuellueberschrift = "Namen"

strSpesen = "Spesen"

strTabelle = "tabelle1"

With Sheets(strTabelle)
  lngUeberschriftRow = .Cells.Find(strQuellueberschrift, LookAt:=xlWhole).Row
  lngNameCol = .Rows(lngUeberschriftRow).Find(strQuellueberschrift, LookAt:=xlWhole).Column
  lngSpesenCol = .Rows(lngUeberschriftRow).Find(strSpesen, LookAt:=xlWhole).Column
  lngFirstRow = .Cells(lngUeberschriftRow, lngNameCol).Row
  
  With .Cells(lngUeberschriftRow, lngNameCol)
    .Subtotal GroupBy:=lngNameCol, Function:=xlSum, TotalList:=Array(lngSpesenCol), _
      Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    .ClearOutline
  End With
  
  lngLastRow = .Cells(Rows.Count, lngNameCol).End(xlUp).Row
  
  For lngI = lngUeberschriftRow To lngLastRow
    .Rows(lngI).Font.Bold = .Cells(lngI, lngNameCol).Value Like "*Ergebnis*"
  Next
End With
End Sub

Gruß Sepp


Bild

Betrifft: Cool nur eins noch
von: Thomas
Geschrieben am: 03.10.2015 10:06:33
Hallo Sepp,
absolut cool, es funktioniert fast.
An dieser Stelle TotalList:=Array(lngSpesenCol) stimmmt was noch nicht ganz.Die variable lngSpesenCol gibt den wert in welcher spalte sich die die spalte spesen befindet. Hier wär es aber
super wenn hier gezählt wird wie weit die Spalten Name und spesen auseinander sind. ( für den fall das die daten nicht in spalte a beginnen.)
Ich hab versucht es mal allein zu schaffen aber das kann ich noch nicht.
kannst du noch mal schauen?
liebe grüsse thomas

Bild

Betrifft: AW: Cool nur eins noch
von: Sepp
Geschrieben am: 03.10.2015 10:14:32
Hallo Thomas,
wieder ungetestet! Sonst wäre eine kleine Beispieldatei hilfreich.

Sub teilergebnis()
Dim lngUeberschriftRow As Long, lngLastRow As Long, lngFirstRow As Long
Dim lngSpesenCol As Long, lngNameCol As Long, lngI As Long
Dim strQuellueberschrift As String, strSpesen As String, strTabelle As String
Dim vntList() As Variant

strQuellueberschrift = "Namen"

strSpesen = "Spesen"

strTabelle = "tabelle1"

With Sheets(strTabelle)
  lngUeberschriftRow = .Cells.Find(strQuellueberschrift, LookAt:=xlWhole).Row
  lngNameCol = .Rows(lngUeberschriftRow).Find(strQuellueberschrift, LookAt:=xlWhole).Column
  lngSpesenCol = .Rows(lngUeberschriftRow).Find(strSpesen, LookAt:=xlWhole).Column
  lngFirstRow = .Cells(lngUeberschriftRow, lngNameCol).Row
  
  Redim Preserve vntList(1 To lngSpesenCol - lngNameCol + 1)
  
  For lngI = 1 To UBound(vntList)
    vntList(lngI) = lngI
  Next
  
  With .Cells(lngUeberschriftRow, lngNameCol)
    .Subtotal GroupBy:=lngNameCol, Function:=xlSum, TotalList:=vntList, _
      Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    .ClearOutline
  End With
  
  lngLastRow = .Cells(Rows.Count, lngNameCol).End(xlUp).Row
  
  For lngI = lngUeberschriftRow To lngLastRow
    .Rows(lngI).Font.Bold = .Cells(lngI, lngNameCol).Value Like "*Ergebnis*"
  Next
End With
End Sub

Gruß Sepp


Bild

Betrifft: AW: Cool nur eins noch
von: Thomas
Geschrieben am: 03.10.2015 10:45:41
Hallo Sepp,
mist klappt nicht. Es werden keine zeilen mehr eingefügt.
vielleicht findet er die summe spalte nicht. Habe ein beispiel erstellt.
https://www.herber.de/bbs/user/100567.xlsm
super das du hilfst
liebe grüsse thomas

Bild

Betrifft: AW: Cool nur eins noch
von: Sepp
Geschrieben am: 03.10.2015 11:38:33
Hallo Thomas,

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub teilergebnis_2()
Dim lngUeberschriftRow As Long, lngLastRow As Long, lngFirstRow As Long
Dim lngSpesenCol As Long, lngNameCol As Long, lngI As Long
Dim strQuellueberschrift As String, strSpesen As String, strTabelle As String
Dim vntList() As Variant

strQuellueberschrift = "Namen"

strSpesen = "Spesen"

strTabelle = "tabelle1"

With Sheets(strTabelle)
  lngUeberschriftRow = .Cells.Find(strQuellueberschrift, LookAt:=xlWhole).Row
  lngNameCol = .Rows(lngUeberschriftRow).Find(strQuellueberschrift, LookAt:=xlWhole).Column
  lngSpesenCol = .Rows(lngUeberschriftRow).Find(strSpesen, LookAt:=xlWhole).Column
  lngFirstRow = .Cells(lngUeberschriftRow, lngNameCol).Row
  
  Redim Preserve vntList(1 To lngSpesenCol - lngNameCol + 1)
  
  For lngI = 1 To UBound(vntList)
    vntList(lngI) = lngI
  Next
  
  With .Cells(lngUeberschriftRow, lngNameCol)
    .Subtotal GroupBy:=lngNameCol - .Column + 1, Function:=xlSum, TotalList:=Array(lngSpesenCol - lngNameCol + 1), _
      Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    .ClearOutline
  End With
  
  lngLastRow = .Cells(Rows.Count, lngNameCol).End(xlUp).Row
  
  For lngI = lngUeberschriftRow To lngLastRow
    .Rows(lngI).Font.Bold = .Cells(lngI, lngNameCol).Value Like "*Ergebnis*"
  Next
End With
End Sub

Gruß Sepp


Bild

Betrifft: Vielen vielen dank an Sepp
von: Thomas
Geschrieben am: 03.10.2015 12:08:21
Hallo Sepp,
einfach nur klasse es klappt super.
hab vielen dank
liebe grüsse thomas

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Select entfernen?"