Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 63777 Skopiuj do schowka VBA mnożenie tabeli przez podaną wartość
Autor Wiadomość
maro123
świeżak


Posty: 6
  Wysłany: 11-01-2019, 19:38   VBA mnożenie tabeli przez podaną wartość

Cześć,
Próbowałem znaleźć kod VBA, który pomnoży wszystkie wartości z tabeli przez podaną wartość w oknie dialogowym. Znalazłem sposoby na przemnożenie tabeli ale przez liczbę zawartą w funkcji...
Macie jakiś pomysł jak powinien wyglądać kod żeby za każdym razem excel pytał przez jaką liczbę przemnożyć wszystkie wartości z tabeli?
ID posta: 360255 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2131 razy
Posty: 7054
Wysłany: 11-01-2019, 20:04   

Bez obsługi błędu.
Zaznacz zakres do przemnożenia i uruchom procedurę.
Kod:
Sub Start()
    Dim liczba      As Double
    Dim kom         As Excel.Range
   
    liczba = Application.InputBox("podaj liczbę", Type:=1)
   
    For Each kom In Selection
        kom.Value = kom.Value * liczba
    Next kom
   
End Sub
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 360257 Skopiuj do schowka
 
 
maro123
świeżak


Posty: 6
Wysłany: 11-01-2019, 20:27   

Super, dzięki wszystko działa.
A da się zrobić tak aby przemnożone wartości otwierały się w identycznej tabeli ale w drugim arkuszu?
ID posta: 360258 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2131 razy
Posty: 7054
Wysłany: 11-01-2019, 20:28   

Pokaż załącznik.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 360259 Skopiuj do schowka
 
 
maro123
świeżak


Posty: 6
Wysłany: 11-01-2019, 20:50   

Wysłałem załącznik na pw.
Nie mogę znaleźć opcji żeby tutaj wstawić.
ID posta: 360261 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 339 razy
Posty: 1805
Wysłany: 11-01-2019, 20:56   

Kliknij [odpowiedz] - znajdziesz opcję. Albo "Szybka odpowiedź" > [Podgląd].
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
I dbajmy - proszę - o poprawną polszczyznę.
ID posta: 360262 Skopiuj do schowka
 
 
maro123
świeżak


Posty: 6
Wysłany: 11-01-2019, 21:03   

W pliku przykładowa tabela, wartości nie są istotne tylko sama zasada działania.

mnożenie.xlsm
Pobierz Plik ściągnięto 20 raz(y) 13.01 KB

ID posta: 360263 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 339 razy
Posty: 1805
Wysłany: 11-01-2019, 21:49   

Kod mnoży kol. B.

Kopia mnożenie.xlsm
Pobierz Plik ściągnięto 23 raz(y) 20.52 KB

_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
I dbajmy - proszę - o poprawną polszczyznę.
ID posta: 360265 Skopiuj do schowka
 
 
maro123
świeżak


Posty: 6
Wysłany: 11-01-2019, 22:12   

Wielkie dzięki! Bardzo mi pomogliście
ID posta: 360266 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 202 razy
Posty: 960
Wysłany: 11-01-2019, 22:35   

... albo przeróbka kodu Mareckiego:
Kod:
Option Explicit

Sub mnozenie_1()
    Dim liczba  As Double
    Dim adres   As String
    Dim kom     As Excel.Range
    Dim arktab  As Excel.Worksheet
   
    liczba = Application.InputBox("podaj liczbę", Type:=1)
   
    With ThisWorkbook
        With .Sheets("Arkusz1")
            .Activate
            Set arktab = ActiveSheet
            adres = .Range("a1").CurrentRegion.Address
        End With
        .Sheets.Add(After:=arktab, Count:=1, Type:=xlWorksheet).Name = "Arkusz" & .Sheets.Count + 1
        With ActiveSheet
            For Each kom In arktab.Range(adres)
                If IsNumeric(kom.Value) Then
                    .Range(kom.Address).Value = kom.Value * liczba
                Else
                    .Range(kom.Address).Value = kom.Value
                End If
            Next kom
        End With
    End With
End Sub
ID posta: 360269 Skopiuj do schowka
 
 
maro123
świeżak


Posty: 6
Wysłany: 11-01-2019, 22:48   

Świetnie, dziękuję za pomoc
ID posta: 360271 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe