Zdravím. Trochu jsem si zkomplikoval život a bez vaší pomoci se budu dlouho trápit, než se to naučím, nebo se zavěsím Ale k věci.
Na jednom stroji potřebuji monitorovat délku dráhy jezdce, který mačká pružiny. Další sledované veličiny jsou výstupy dvou tenzometrů. Délka a potažmo rychlost je snímána encodérem. Programem stroje je generována čtvrtá proměnná (lineární) a tou je časová osa, tu tvoří výstup čítače s hodinovým vstupem 50ms. Celý proces trvá cca 2s, čítač tedy nabývá hodnot 0-cca 100. Všechny proměnné jsou přenášeny do PC, respektive Excelu, rozhraním DDE. Časová osa je přenášena do buňky A1. Do buněk A2:A4 jsou přenášeny okamžité hodnoty encodéru a obou tentometrů. Až do tohoto místa vše umím a tudíž vše funguje. Co neumím, je donutit tabulku, aby :
při hodnotě čítače (A1) 1, přepsala stav buňky A2 do buňky B1, stav A3 do C1 a stav A4 do D1,
při hodnotě čítače (A1) 2, přepsala stav buňky A2 do buňky B2, stav A3 do C2 a stav A4 do D2,
při hodnotě čítače (A1) 3, přepsala stav buňky A2 do buňky B3, stav A3 do C3 a stav A4 do D3,
.
.
.
Díky za záchranu mého duševního zdraví a dost možná i života...
Excel-přesun čísel z buňky A do buněk B1-Bx Vyřešeno
- karlos
- Master Level 8
- Příspěvky: 6447
- Registrován: květen 05
- Bydliště: Domažlice
- Pohlaví:
- Stav:
Offline
Excel-přesun čísel z buňky A do buněk B1-Bx
Co nejde silou, jde ještě větší silou... :-)
- Branscombe
- Level 3
- Příspěvky: 469
- Registrován: červen 09
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
navstevnik to urcite vymysli lepe a elegantneji, ale kdybych toto potřeboval napsat, tak bych ve VBA pro příslušný list vložil následující kód:
Kód: Vybrat vše
Private Sub Worksheet_change(ByVal Target As Range)
Dim CellA2 As Range, CellA3 As Range, CellA4 As Range
Set CellA2 = Range("A2")
Set CellA3 = Range("A3")
Set CellA4 = Range("A4")
If Range("A1") = "1" Then
Range("B1").Value = CellA2
Range("C1").Value = CellA3
Range("D1").Value = CellA4
ElseIf Range("A1") = "2" Then
Range("B2").Value = CellA2
Range("C2").Value = CellA3
Range("D2").Value = CellA4
ElseIf Range("A1") = "3" Then
Range("B3").Value = CellA2
Range("C3").Value = CellA3
Range("D3").Value = CellA4
End If
End Sub
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
V editoru VBA vloz do modulu prislusneho listu udalostni proceduru, je to pracovni verze, predpoklad je, ze bunky A1:A4 jsou naplnovany postupne pocinaje A1:
Ozvi se, jak to funguje.
Bude potreba asi doresit vyprazdneni bloku B1:Dxx,...., snad bude mozne i zjednoduseni
Kód: Vybrat vše
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SBlk As Range
If Not Intersect(Target, Me.Range("a4")) Is Nothing Then
With Me
' kdyz je jiz naplnena A4
If .Range("a4").Value <> vbNullString Then
Set SBlk = .Range("a2:a4")
Application.EnableEvents = False
' transpozice
SBlk.Copy
.Range("b" & .Range("a1").Value).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
' odstranit obsah A1:A4
SBlk.Resize(4, 1).Offset(-1, 0).ClearContents
Application.EnableEvents = True
Set SBlk = Nothing
End If
End With
End If
End Sub
Ozvi se, jak to funguje.
Bude potreba asi doresit vyprazdneni bloku B1:Dxx,...., snad bude mozne i zjednoduseni
- karlos
- Master Level 8
- Příspěvky: 6447
- Registrován: květen 05
- Bydliště: Domažlice
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
Díky za rychlé reakce. Testovat budu až zítra, takže reference budou až později.
ad Branscombe: hodnota proměnné v A1 je závislá na rychlosti cyklu, tedy čase a taktu čítače. V tuto chvíli bych musel nadatlovat smyčku 100krát a pokud bych chtěl zjemnit vzorkování encodéru a tenzometrů nejvyšším možným taktem 10ms, pak bych se dostal na hodnotu 500 Každpádně však dík za velmi jednoduchý a snadno pochopitelný postrk kupředu.
ad Návštěvník: Jelikož se chystám usnout a cítím se trochu vyždímaný, tak to zatím moc nepobírám. Ráno snad budu moudřejší... no uvidíme... Buňky A1:A4 jsou zaplněny stále a jejich hodnota se mění za letu. Celé to mám vymyšlené tak, že by se to mělo chovat v principu, jako PCM. Změny posuvu a váhy jsou převáděny na číselné posloupnosti a jejich vzorky jsou ukládány do tabulky "samplovací frekvencí" 20Hz, přičemž každý vzorkovací impuls je očíslovaný pro snadnější vytvoření tabulky (A1).
ad Branscombe: hodnota proměnné v A1 je závislá na rychlosti cyklu, tedy čase a taktu čítače. V tuto chvíli bych musel nadatlovat smyčku 100krát a pokud bych chtěl zjemnit vzorkování encodéru a tenzometrů nejvyšším možným taktem 10ms, pak bych se dostal na hodnotu 500 Každpádně však dík za velmi jednoduchý a snadno pochopitelný postrk kupředu.
ad Návštěvník: Jelikož se chystám usnout a cítím se trochu vyždímaný, tak to zatím moc nepobírám. Ráno snad budu moudřejší... no uvidíme... Buňky A1:A4 jsou zaplněny stále a jejich hodnota se mění za letu. Celé to mám vymyšlené tak, že by se to mělo chovat v principu, jako PCM. Změny posuvu a váhy jsou převáděny na číselné posloupnosti a jejich vzorky jsou ukládány do tabulky "samplovací frekvencí" 20Hz, přičemž každý vzorkovací impuls je očíslovaný pro snadnější vytvoření tabulky (A1).
Co nejde silou, jde ještě větší silou... :-)
- karlos
- Master Level 8
- Příspěvky: 6447
- Registrován: květen 05
- Bydliště: Domažlice
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
Omlouvám se za pozdní report. Ale pár hodin jsem zabil opravou jiného stroje a pak jsem absolvoval sezení s vedením firmy na téma grafů a 100% kontroly pružin na váhu u stroje, kterého se týká tento topic.
První kód nefunguje a druhý jsem ještě nezkoušel, nicméně mám obavu, že se mu také nebude chtít pracovat mravně, právě pro již zmiňovanou podmínku zaplnění poslední (A4) buňky. Určující pro přepis by měla být změna buňky A1, pokud budou buňky A2:A4 prázdné, nic se neděje, nic se nepřepíše. Mazání buněk B1:Dn není nutné. V novém cyklu se přepíší novými hodnotami.
O půl hodiny později...
Bohužel ani druhý kód nemaká. Mám však nové poznatky. Pokud jsem v obou případech odstranil z buněk A1:A4 propojení na program UniDDE =UniDDE|Items!'lblDDE(1)' ... =UniDDE|Items!'lblDDE(4)' a na jejich místo dosadil konkrétní čísla, pak se čísla přepisovala do správných buněk. Tedy v případě kódu od návštěvníka. Kód od Branscomba se po prvním přepisu zacyklil a učinil Excel neovladatelným.
První kód nefunguje a druhý jsem ještě nezkoušel, nicméně mám obavu, že se mu také nebude chtít pracovat mravně, právě pro již zmiňovanou podmínku zaplnění poslední (A4) buňky. Určující pro přepis by měla být změna buňky A1, pokud budou buňky A2:A4 prázdné, nic se neděje, nic se nepřepíše. Mazání buněk B1:Dn není nutné. V novém cyklu se přepíší novými hodnotami.
O půl hodiny později...
Bohužel ani druhý kód nemaká. Mám však nové poznatky. Pokud jsem v obou případech odstranil z buněk A1:A4 propojení na program UniDDE =UniDDE|Items!'lblDDE(1)' ... =UniDDE|Items!'lblDDE(4)' a na jejich místo dosadil konkrétní čísla, pak se čísla přepisovala do správných buněk. Tedy v případě kódu od návštěvníka. Kód od Branscomba se po prvním přepisu zacyklil a učinil Excel neovladatelným.
Co nejde silou, jde ještě větší silou... :-)
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
To, ze muze nastat stav, kdy bude zapsana nova hodnota do A1 a nebudou zapsany dalsi hodnoty A2:A4 jsi neuvedl. Cekani na zapis posledni hodnoty jsem zvolil z duvodu uspory casu behu procedury, cca 1/5 proti provedeni bez cekani, coz muze mit negativni dopad pri taktu 10 ms.
Takze upravena procedura:
Pro pripad chyboveho ukonceni behu, kdy bylo deaktivovano prepocitavani listu ( Application.CutCopyMode = False) zavolej proceduru pro obnoveni:
Protoze nemam moznost realneho overeni jinak nez tvym prostrednictvim, jsem zvedav na vysledek.
Funkcnost procedury mohu overit pouze (do standardniho modulu):
Takze upravena procedura:
Kód: Vybrat vše
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SBlk As Range
With Me
If Not Intersect(Target, .Range("a1:a4")) Is Nothing Then
Set SBlk = .Range("a2:a4")
Application.EnableEvents = False
' kdyz je naplnena A1
If Target.Address = "$A$1" Then
' odstranit obsah A2:A4
SBlk.ClearContents
End If
' transpozice
If .Range("a1").Value <> vbNullString Then
SBlk.Copy
.Range("b" & .Range("a1").Value).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End If
Application.EnableEvents = True
Set SBlk = Nothing
End If
End With
End Sub
Pro pripad chyboveho ukonceni behu, kdy bylo deaktivovano prepocitavani listu ( Application.CutCopyMode = False) zavolej proceduru pro obnoveni:
Kód: Vybrat vše
Sub AEE()
Application.EnableEvents = True
End Sub
Protoze nemam moznost realneho overeni jinak nez tvym prostrednictvim, jsem zvedav na vysledek.
Funkcnost procedury mohu overit pouze (do standardniho modulu):
Kód: Vybrat vše
Option Explicit
Sub test()
Dim i As Integer, Wsht As Worksheet
Dim T As Single
Set Wsht = ThisWorkbook.Worksheets("list1")
T = Timer()
Application.ScreenUpdating = False
For i = 1 To 100
With Wsht.Range("a1")
.Value = i
.Offset(1, 0).Value = i ' + 10
.Offset(2, 0).Value = i + 100
.Offset(3, 0).Value = i + 1000
End With
Next i
Application.ScreenUpdating = True
Debug.Print Timer() - T
Set Wsht = Nothing
End Sub
- karlos
- Master Level 8
- Příspěvky: 6447
- Registrován: květen 05
- Bydliště: Domažlice
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
Tak zase nic Pokud jsem z A1 vymazal odkaz na UniDDE a nahradil jej konkrétní číslicí, pak kód učinil pokus o přepis a zároveň vymazal odkazy na UniDDE z A2:A4, čímž ztratil kontakt s tímto programem, přenášejícím hodnoty analogových veličin do tabulky.
Víkend na krku a jelikož před chvílí na inkriminovaném stroji začala druhá směna výrobu a tím mě odsunula od možnosti experimentů, ponechme problém uzrát. Pokusím se tvými kódy přes víkend prokousat a pochopit je, abych ti mohl blíže konkretizovat, co ano a co ne. Prozatím díky za tvůj čas a cenné rady.
Víkend na krku a jelikož před chvílí na inkriminovaném stroji začala druhá směna výrobu a tím mě odsunula od možnosti experimentů, ponechme problém uzrát. Pokusím se tvými kódy přes víkend prokousat a pochopit je, abych ti mohl blíže konkretizovat, co ano a co ne. Prozatím díky za tvůj čas a cenné rady.
Co nejde silou, jde ještě větší silou... :-)
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
Koukal jsem na informace o UniDDE, nejspis postaci odstranit mazani obsahu bunek A2:A4. Procedura reaguje na zmeny v bunkach A1:A4 a podle hodnoty xx v A1 transponuje obsah bunek A2:A4 do bunek Bxx:Dxx:
Komunikaci mezi PC a zarizenim si v Excelu dopln podle konkretni implementace UniDDE.
Kód: Vybrat vše
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SBlk As Range
With Me
If Not Intersect(Target, .Range("a1:a4")) Is Nothing Then
Set SBlk = .Range("a2:a4")
Application.EnableEvents = False
' transpozice
If .Range("a1").Value <> vbNullString Then
SBlk.Copy
.Range("b" & .Range("a1").Value).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End If
Application.EnableEvents = True
Set SBlk = Nothing
End If
End With
End Sub
Komunikaci mezi PC a zarizenim si v Excelu dopln podle konkretni implementace UniDDE.
- karlos
- Master Level 8
- Příspěvky: 6447
- Registrován: květen 05
- Bydliště: Domažlice
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
Dík. V pondělí to testnu. Přeji hezký víkend.
Co nejde silou, jde ještě větší silou... :-)
- karlos
- Master Level 8
- Příspěvky: 6447
- Registrován: květen 05
- Bydliště: Domažlice
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx
Asi nejsem jediným, kdo není v zaměstnání svým pánem tak se tedy stalo, že jsem musel předchozí pokusy zastavit a věnovat se jiné práci. Nyní nadchází dny zděšení, kdy šéf zjistil, že mám fyzický defekt, mám totiž jen dvě ruce a pro jednu práci nestíhám druhou, třetí, čtvrtou, pátou a do toho ještě opravovat závady na stávajících strojích, neboť světe div se, jsou dovolené a jsem tu sám... ostatně je to stejné každý rok
Ale dost zbytečných řečí. Poslední script má snahu fungovat, je zde však ono pověstné ALE. Aby se script provedl, musí se hodnota v buňce A1 "odentrovat", což utilita pro komunikaci stroj>Excel nedělá. Přikládám tabulku, ve které se vkládají hodnoty "od stroje" do buněk A5:A8, tyto se kopírují do A1:A4. Změna hodnoty A1 (bez [enter]) má provést přepsání hodnot A2 do buněk B(A1), A3 do buněk C(A1) a A3 do buněk D(A1).
Předem díky za pomoc a omlouvám se za přerušení, které nebylo zcela v mých rukou. Koneckonců nám jen dvě
Ale dost zbytečných řečí. Poslední script má snahu fungovat, je zde však ono pověstné ALE. Aby se script provedl, musí se hodnota v buňce A1 "odentrovat", což utilita pro komunikaci stroj>Excel nedělá. Přikládám tabulku, ve které se vkládají hodnoty "od stroje" do buněk A5:A8, tyto se kopírují do A1:A4. Změna hodnoty A1 (bez [enter]) má provést přepsání hodnot A2 do buněk B(A1), A3 do buněk C(A1) a A3 do buněk D(A1).
Předem díky za pomoc a omlouvám se za přerušení, které nebylo zcela v mých rukou. Koneckonců nám jen dvě
- Přílohy
-
- Warm-graf.xls
- (25.5 KiB) Staženo 46 x
Co nejde silou, jde ještě větší silou... :-)
- karlos
- Master Level 8
- Příspěvky: 6447
- Registrován: květen 05
- Bydliště: Domažlice
- Pohlaví:
- Stav:
Offline
Re: Excel-přesun čísel z buňky A do buněk B1-Bx Vyřešeno
Problém vyřešen pomocí vývojového prostředí Promotic. Děkuji všem, kteří se mi snažili pomoci.
Co nejde silou, jde ještě větší silou... :-)
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Excel - filtr na formát buňky + obsah Příloha(y)
od popcorn » 19 zář 2023 17:07 » v Kancelářské balíky - 0
- 3311
-
od popcorn
Zobrazit poslední příspěvek
19 zář 2023 17:07
-
-
- 16
- 8447
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
-
- 3
- 1699
-
od mmmartin
Zobrazit poslední příspěvek
28 kvě 2024 23:45
-
- 1
- 1587
-
od Grimm
Zobrazit poslední příspěvek
12 bře 2024 21:43
-
-
Excel komparacedvou soborů Příloha(y)
od teichmann.ondrej » 15 dub 2024 17:26 » v Kancelářské balíky - 11
- 4739
-
od teichmann.ondrej
Zobrazit poslední příspěvek
22 dub 2024 15:45
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 2 hosti