Thema Datum  Von Nutzer Rating
Antwort
05.10.2020 12:59:56 Himmelerde
NotSolved
05.10.2020 13:30:40 Gast28377
NotSolved
07.10.2020 12:54:45 Gast74651
NotSolved
07.10.2020 13:58:39 Gast15029
NotSolved
Rot code gefällig?
07.10.2020 14:21:51 ralf_b
NotSolved
07.10.2020 15:19:53 Gast68233
NotSolved

Ansicht des Beitrags:
Von:
ralf_b
Datum:
07.10.2020 14:21:51
Views:
666
Rating: Antwort:
  Ja
Thema:
code gefällig?
Sub Datenimport()
Dim WB As Workbook, AveragePD As Double, lr, lr1 As Long, wksZIEL As Worksheet
Dim Zeile As Long
Dim vFile As Variant

Set wksZIEL = ActiveSheet
Zeile = 3
vFile = Application.GetOpenFilename
If vFile = False Then Exit Sub

Application.ScreenUpdating = False
lr = Cells(Rows.Count, 6).End(xlUp).Row + 1
Set WB = Workbooks.Open(vFile)
lr1 = wksZIEL.Cells(Rows.Count, 6).End(xlUp).Row + 1
lr = WB.Sheets(1).Cells(Rows.Count, 7).End(xlUp).Row
Spalte = 15
Zeile = 4
Zeilewks = lr1
ls = WB.Sheets(1).Cells(2, 15).End(xlToRight).Column
AveragePD = wksZIEL.Application.WorksheetFunction.Average(wksZIEL.Range(wksZIEL.Cells(3, 13), wksZIEL.Cells(lr1 - 1, 13)))
    For Zeile = Zeile To lr
        If WB.Sheets(1).Cells(Zeile, 14) > 3 * AveragePD Then
            iClick = MsgBox(prompt:="Hast du die möglichen falschen Werte überpüft?", Buttons:=vbYesNo)
            If iClick = vbNo Then
                WB.Sheets(1).Cells(Zeile, 14).EntireRow.Interior.ColorIndex = 3
                WB.Sheets(1).Cells(Zeile, ls + 1) = "X"
                WB.Sheets(1).Range("A3:R3").AutoFilter Field:=18, Criteria1:="X"
                
                Exit Sub
            ElseIf iClick = vbYes Then
                MsgBox "Die Daten werden eingelesen"
                Exit For
            End If
        End If
    Next
End Sub

 


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
05.10.2020 12:59:56 Himmelerde
NotSolved
05.10.2020 13:30:40 Gast28377
NotSolved
07.10.2020 12:54:45 Gast74651
NotSolved
07.10.2020 13:58:39 Gast15029
NotSolved
Rot code gefällig?
07.10.2020 14:21:51 ralf_b
NotSolved
07.10.2020 15:19:53 Gast68233
NotSolved