Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

VBA - wykonywanie działań na określonej ilości wierszy

Kazan92 12 Lut 2019 15:34 102 1
  • #1 12 Lut 2019 15:34
    Kazan92
    Poziom 1  

    Cześć,
    Stworzyłem makro do tworzenia Analizy ABC towarów na magazynie. Makro działa dla zakresu towarów od 1 do 10000. A działa następująco:
    1. W arkuszu "dane" wklejamy dane dotyczące towarów (symbol/nazwa/j.m./wartość do analizy)
    2. Klikamy przycisk "Stwórz Analizę ABC", makro tworzy nowy arkusz o nazwie "ABC" i tam wykonuje wszystkie działania z analizy.

    Pytanie brzmi następująco:
    Jak ograniczyć zakres obliczeń w arkuszu "ABC" do ilości wierszy podanych w arkuszu "Dane"?
    Chodzi o to, że jak np. podam 100 rekordów to nie chce żeby liczyło do 10000, tylko do 100.
    Mogę zmienić zakres obliczeń, ale makro ma być uniwersalne i mogą zdarzyć się przypadki gdy do analizy będzie potrzebne 10000 wierszy oraz takie w których będzie 100 wierszy.
    Może ktoś ma jakiś pomysł?

    Sub ABC()
    Sheets("Dane").Select
    Range("A1:D10000").Select
    Selection.Copy
    Sheets.Add
    ActiveSheet.Name = "ABC"
    Range("A1").Select
    Selection.PasteSpecial
    Range("D1").Select
    ActiveWorkbook.Worksheets("ABC").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ABC").sort.SortFields.Add Key:=Range("D1"), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("ABC").sort
    .SetRange Range("A2:D10000")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    Cells(1, 5).Value = "% udział wartości w całości"
    Columns("E:E").EntireColumn.AutoFit
    Cells(1, 6).Value = "Skumulowana wartość zużycia w %"
    Columns("F:F").EntireColumn.AutoFit
    Cells(1, 7).Value = "KLASA"
    Columns("G:G").EntireColumn.AutoFit
    Range("E10001").Value = Application.WorksheetFunction.Sum(Range("D2:D10000"))
    Range("E2").Select
    ActiveWindow.SmallScroll Down:=-12
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/R10001C5"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E10000"), Type:=xlFillDefault
    Range("E2:E10000").Select
    Selection.Style = "Percent"
    Range("E2").Select
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+RC[-1]"
    Range("F3").Select
    Selection.AutoFill Destination:=Range("F3:F10000")
    Range("F3:F10000").Select
    ActiveWindow.SmallScroll Down:=-6
    Range("F3").Select
    Dim i As Integer
    Sheets("ABC").Select
    For g = 2 To 10000
    If Cells(g, 6) > 0 And Cells(g, 6) <= 0.8 Then
    Cells(g, 7) = "A"
    ElseIf Cells(g, 6) > 0.8 And Cells(g, 6) <= 0.95 Then
    Cells(g, 7) = "B"
    ElseIf Cells(g, 6) > 0.95 And Cells(g, 6) <= 1 Then
    Cells(g, 7) = "C"
    End If
    Next g
    For Each komórka In Range("g2:g10000")
    If komórka = "A" Then
    komórka.Interior.Color = rgbGreen
    komórka.Select
    ElseIf komórka = "B" Then
    komórka.Interior.Color = rgbYellow
    komórka.Select
    ElseIf komórka = "C" Then
    komórka.Interior.Color = rgbRed
    komórka.Select
    End If
    Next komórka
    Range("A1").Select
    End Sub

    0 1
  • #2 14 Lut 2019 06:23
    adamas_nt
    Moderator Programowanie

    Najprościej: podstaw sobie z InputBox'a, Np

    Kod: vbscript
    Zaloguj się, aby zobaczyć kod

    0