< návrat zpět

MS Excel


Téma: Makro, nekopíruje 0. rss

Zaslal/a 17.8.2019 19:47

Mám problém u makra, které hodím poté pod tohle. Makro tahá z HTML protokolu určitě data. Vše funguje až na to, když buňka začíná na0, tak to tu nulu nezkoporiruje. Příklad 00H52 ale makro zkopírujte pouze H52. Kdyby někdo věděl pomoci dekuju.

Sub GetFileCopyData()
Dim Fname As String
Dim SrcWbk As Workbook
Dim DestWbk As Workbook


Set DestWbk = ThisWorkbook

Fname = Application.GetOpenFilename(FileFilter:=Clear, Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)

SrcWbk.Sheets(1).Name = "List1"


SrcWbk.Sheets("List1").Range("A42:E75").Copy DestWbk.Sheets("match").Range("B:F")


SrcWbk.Close False

Sheets("match").Select
Columns("B:F").Select
Selection.Hyperlinks.Delete
Selection.UnMerge
Columns("E:E").Select
Selection.Cut Destination:=Columns("G:G")
Columns("F:G").Select
Selection.Cut Destination:=Columns("E:F")


'
Range("B1:G319").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlLTR
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlLTR
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("B:B").Select
Selection.Font.Bold = False
Selection.Font.Bold = True

Range("B1:G238").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("H15").Select
Sheets("RSV").Select
End Sub

Zaslat odpověď >

#043983
elninoslov
Makro je nahrané záznamníkom, teda je tam polka zbytočná, každopádne, ak je formát buniek Text, tak to kopíruje správne.
Načo presúvať stĺpec za iný, a potom oba doľava, keď stačí posunúť len krajný do ľava?
Raz formátujete oblasť po riadok 319, potom len po riadok 238. Určite správne ?
Kopírujete stále asi tú istú oblasť, potom netreba toľko riadkov.
Načo stále formátovať skopírované bunky, keď môžete skopírovať iba hodnoty, do vopred naformátovanej oblasti.
Ak by ste poznal názov listu, dali by sa vložiť jednoúčelovo iba vzorce s odkazom na hodnotu a previesť ich na hodnotu, bolo by to bez pomalého otvárania súboru.
...
Navrhujem "malú" zmenu makra.
Příloha: zip43983_zdrojciel.zip (31kB, staženo 16x)
citovat
#043984
avatar
Aj ja mám problém u toho makra. Už iba jeho čítanie je utrpenie.citovat
#043985
avatar

elninoslov napsal/a:

Makro je nahrané záznamníkom, teda je tam polka zbytočná, každopádne, ak je formát buniek Text, tak to kopíruje správne.
Načo presúvať stĺpec za iný, a potom oba doľava, keď stačí posunúť len krajný do ľava?
Raz formátujete oblasť po riadok 319, potom len po riadok 238. Určite správne ?
Kopírujete stále asi tú istú oblasť, potom netreba toľko riadkov.
Načo stále formátovať skopírované bunky, keď môžete skopírovať iba hodnoty, do vopred naformátovanej oblasti.
Ak by ste poznal názov listu, dali by sa vložiť jednoúčelovo iba vzorce s odkazom na hodnotu a previesť ich na hodnotu, bolo by to bez pomalého otvárania súboru.
...
Navrhujem "malú" zmenu makra.Příloha: 43983_zdrojciel.zip (31kB, staženo 2x)


ano, vaše makro funguje, ale stejně mi to tam ty nuly nehodilo...citovat
#043986
avatar
@elninoslav

V cilovém dokumentu jsou buňky nastavené na text.
Ale tahá to z HTML souboru, kde nejsem schopný ovlivnit formát buněk?citovat
#043987
elninoslov
Vy vo Workbooks.Open(Fname) otvárate HTML dokument ? Ukážte aká je to stránka, alebo rovno ten HTML dokument. Na to treba asi skúsiť Import dát, Data z webu, PowerQuery, alebo rozklad kolekcie elementov v makre, prípadne parsovať kód html...citovat
#043993
Stalker
Co kdybys poskytnul ten vzorek dat jak žádá elnino, místo toho spamování a zakládání dalších dotazů na jiných poradnáchcitovat
#044005
avatar
@stalker Naučte se nejdřív jednat s lidmi, a pak něco pište. Je jasné, že pokud nenajdu odpověd na jednom forum jdu se zeptat na druhý. Já bohužel nemám čas jako vy, šmejdit po forech a stalkovat lidi.
A je jasné podruhé, že ne každá data může člověk pouštět na internet :)

A našel jsem forum kde mi byli schopni poradit i na základě tohodle makra. Ty jsou od toho aby pomohli, ne jako vy, který tu tyká každýmu koho potká a hledá jestli nezaložil více věcí na více forech. Nashlecitovat
#044006
elninoslov
No a v čom bol ten povestný "pudel" zakopaný ?citovat
#044007
avatar

elninoslov napsal/a:

No a v čom bol ten povestný "pudel" zakopaný ?


V chování toho emo týpka.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