Thema Datum  Von Nutzer Rating
Antwort
08.12.2014 14:53:01 Jens
NotSolved
10.12.2014 21:43:24 Gast12942
NotSolved
12.12.2014 16:34:34 Jenns
NotSolved
12.12.2014 19:26:00 Gast12942
NotSolved
Rot Wertebereich Suche - dauert lange
13.12.2014 16:41:34 Gast85456
NotSolved
15.12.2014 15:11:58 Jens
NotSolved

Ansicht des Beitrags:
Von:
Gast85456
Datum:
13.12.2014 16:41:34
Views:
789
Rating: Antwort:
  Ja
Thema:
Wertebereich Suche - dauert lange

Moin Jens,

die Zeit fressen einzig die Kopiervorgänge – können ja xxxx werden!

wenn dir die .values genügen (ohne Formatierung), dann schreib den Code –

aber so:

1
2
3
4
5
6
7
8
9
10
'Worksheets("Tabelle13").Range("A" & i, "D" & i).Copy _
    Destination:=Worksheets("Tabelle12").Range("A" & j)
    Worksheets("Tabelle12").Range("A" & j).Value = _
      Worksheets("Tabelle13").Range("A" & i).Value
   Worksheets("Tabelle12").Range("B" & j).Value = _
      Worksheets("Tabelle13").Range("B" & i).Value
   Worksheets("Tabelle12").Range("C" & j).Value = _
      Worksheets("Tabelle13").Range("C" & i).Value
   Worksheets("Tabelle12").Range("D" & j).Value = _
      Worksheets("Tabelle13").Range("D" & i).Value

 

Der Kopierturbo geht so:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
 
Sub MeinAutoFilter()
'Private Sub CommandButton1_Click()
Dim laengeEingabe As Double
Dim breiteEingabe As Double
Dim hoeheEingabe As Double
 
Dim c As Range, specc As Range
Dim j As Integer
 
Dim oWsh13 As Worksheet
Dim oWsh12 As Worksheet
 
'ersatz für Test
laengeEingabe = 2.5
breiteEingabe = 1.2
hoeheEingabe = 1.5
 
Set oWsh13 = ThisWorkbook.Sheets("Tabelle13")
Set oWsh12 = ThisWorkbook.Sheets("Tabelle12")
 
j = 2
With oWsh12 'Bestand löschen
   Set c = .Cells(j, 1)
   Set c = Range(c, c.End(xlDown).Offset(, 3))
   c.Clear
End With
 
With oWsh13 'Filtern
 
   Set c = .Cells(j, 1)
   Set c = Range(c, c.End(xlDown).Offset(, 3))
   c.AutoFilter
   c.AutoFilter Field:=2, _
   Criteria1:=Replace("<=" & Trim(CStr(CDbl(laengeEingabe))), ",", "."), _
   Operator:=xlAnd
   c.AutoFilter Field:=3, _
   Criteria1:=Replace("<=" & Trim(CStr(CDbl(breiteEingabe))), ",", "."), _
   Operator:=xlAnd
   c.AutoFilter Field:=4, _
   Criteria1:=Replace("<=" & Trim(CStr(CDbl(hoeheEingabe))), ",", "."), _
   Operator:=xlAnd
   Set specc = c.SpecialCells(xlCellTypeVisible)
   c.Copy Destination:=oWsh12.Cells(2, j)
   c.AutoFilter
 
End With
 
'UserForm2.Hide
'Ende:
 
Set oWsh13 = Nothing
Set oWsh12 = Nothing
 
End Sub

Und Tschüss


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
08.12.2014 14:53:01 Jens
NotSolved
10.12.2014 21:43:24 Gast12942
NotSolved
12.12.2014 16:34:34 Jenns
NotSolved
12.12.2014 19:26:00 Gast12942
NotSolved
Rot Wertebereich Suche - dauert lange
13.12.2014 16:41:34 Gast85456
NotSolved
15.12.2014 15:11:58 Jens
NotSolved