< návrat zpět

MS Excel


Téma: sečti buňky ze všech listů rss

Zaslal/a 13.9.2016 20:45

Ahoj,

mám toto makro, které vybere jednotlivé buňky ze všech listů v sešitě, kromě listu "vyroba" a vytvoří souhrn.

Private Sub SectiBunky()
Dim ws As Worksheet, st As Long
Application.ScreenUpdating = False
Sheets(1).Activate
Range("E55:W64").ClearContents
st = 55

For Each ws In Worksheets
If LCase(ws.Name) <> "vyroba" Then
ws.Range("G50:K50").Copy
Range("G" & st).PasteSpecial Paste:=xlPasteValues
ws.Range("E49").Copy
Range("E" & st).PasteSpecial Paste:=xlPasteValues
ws.Range("E50").Copy
Range("F" & st).PasteSpecial Paste:=xlPasteValues
ws.Range("S50").Copy
Range("S" & st).PasteSpecial Paste:=xlPasteValues
ws.Range("S6").Copy
Range("T" & st).PasteSpecial Paste:=xlPasteValues
ws.Range("W50").Copy
Range("W" & st).PasteSpecial Paste:=xlPasteValues
st = st + 1
End If
Next ws

Application.ScreenUpdating = True
End Sub


Nyní bych potřeboval k buňce E49 přičíst K48 a součet vložit do sloupce "E", kam se již nyní vkládá. To stejné potřebuji u E50 + K47 s vložením do sloupce "F".

Věděl by někdo pomoci?
Díky.

Zaslat odpověď >

#032778
elninoslov
Je to meniaci sa počet listov ?
Názvy listov sa menia ? (kvôli tomu, či by nestačil 3D vzorec)
Čo to je za skomolenú vetu o tých súčtoch ? Ktorá hodnota sa berie zo "zlúčeného" listu, a ktorá z dátových ???
Ak by bolo tých listov veľa, takýmto spôsobom to bude pomalé. Potom použite niečo takéto, ako posielam - polia. Škoda, že výsledok nieje súvislá oblasť, bolo by to ešte rýchlejšie. Akurát je to neprehľadnejšie.

Najlepšie urobíte, ak vložíte názornú prílohu. Aby som Vám mohol tie súčty doplniť.
Příloha: zip32778_hodnoty-psolu-makrom.zip (18kB, staženo 22x)
citovat
#032779
avatar
Ano, počet listů se mění.
Názvy listů se mění.

Hodnota na tomto řádku se bere z datového listu:
ws.Range("E49").Copy

Tato hodnota dává dohromady součet:
Range("E" & st).PasteSpecial Paste:=xlPasteValues

Potřebuji něco ve smyslu:
ws.Range("E49") + "K48".Copy ale tak, aby to bylo správně :-)

Počet listů je někdy 2, někdy 10, nicméně makro do teď fungovalo správně a pro tento počet listů dostatečně rychle. Jediné co potřebuji je přidat do součtu 2 buňky.

Nyní odjíždím pryč, snad odpoledne nebo k večeru bych mohl přidat přílohu.
Díky.citovat
#032780
elninoslov
V tom prípade Vám stačí aj toto:
Private Sub SectiBunky2()
Dim ws As Worksheet, r As Long
Application.ScreenUpdating = False
Range("E55:W64").ClearContents
r = 55
For Each ws In Worksheets
With ws
If LCase(.Name) <> "vyroba" Then
Range("E" & r) = .Range("E49") + .Range("K48")
Range("F" & r) = .Range("E50") + .Range("K47")
Range("G" & r & ":K" & r) = .Range("G50:K50").Value
Range("S" & r) = .Range("S50")
Range("T" & r) = .Range("S6")
Range("W" & r) = .Range("W50")
r = r + 1
End If
End With
Next ws
Application.ScreenUpdating = True
End Sub
citovat
#032800
avatar
Skvělé, funguje na 1!
Díky moc elninoslov...citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje