Dynamic Ranges

[madalina.petre]

Buna,

Am urmatoarea problema: am un fisier Excel care arata cam asa
(pe prima coloana un label, apoi empty cells pana la urmatorul label iar pe urmatoarele coloane niste valori)... Cum as putea face sa aduc fisierul la foma: label (pe prima coloana, fara spatii) iar cell-ul din a doua coloana toate acele valori separate prin virgula?

*D120AA 207203 207206 207229 207245 207251 207266 207268 207300 207318 207329
207370 207377 207391 207395 207415 207420 207528 207529 207547 207553
207589 207590 207608 207632 207651 207671 207677 207698 207722 207736
207749 207752 207757 207785 207789 207807 207824 207831 207837 207838
207841 207928 207933 207935 207939 207968 603203 603247 603288 603289
603296 603320 603339 603380 603391 603404 603415 603462 603479 603484
603495 603502 603507 603529 603531 603570 603571 603703 603738 603767
603774 603781 603785 603792 603854 603867 603887 603904 603930 603945
603978 802210 802279 802307 802324 802326 802343 802349 802353 802355
802356 802363 802373 802379 802380 802393 802460 802491 802535 802540
802545 802556 802584 802595 802622 802673 802758 802759 802782 802793
802825 802829 802990
*L120AA 207223 207225 207246 207273 207291 207297 207327 207368 207405 207409
207423 207434 207437 207439 207560 207563 207564 207586 207606 207634
207693 207695 207723 207732 207787 207827 207876 207884 207924 207926
207929 207942 207947 207962 207989 207992 207998 603233 603264 603272
603406 603456 603464 603465 603469 603526 603588 603605 603621 603623
603624 603625 603627 603634 603644 603654 603668 603669 603776 603820
603852 603859 603866 603875 603892 603927 603938 603943 802200 802228
802235 802259 802263 802325 802434 802436 802453 802482 802485 802496
802537 802763 802800 802843 802869 802875 802885 802886 802992
*D126AA 413212 413350 413388 413391 413406
*I126AA 413204 413209 413210 413230 413234 413237 413244 413250 413262 413265
413281 413297 413299 413302 413309 413312 413329 413330 413331 413335
413336 413348 413351 413355 413374 413404 413409 413427 413433 413439
413441 413446 413467 413478 413507 413519 413522 413530 413531 413537
413544 413563 413575 413626 413627 413636 413695 413698 413707 413732
413733 413736 413739 413777 413822 413827 413834 413847 413885 413896
*C128AA 334384 334540 334560 334664 339221 339222 339223 339224 339225 339226
339244 339298 339368 404205 404232 404254 404270 404287 404290 404324
404327 404328 404333 404335 404370 404381 404382 404396 404398 404419
404423 404425 404426 404447 404472 404479 404481 404484 404493 404494
404519 404534 404549 404565 404573 404587 404603 404606 404620 404632
404635 404638 404654 404662 404665 404666 404673 404692 404709 404719
404720 404721 404732 404733 404736 404804 404808 404809 404826 404860
404865 404891 404900 404901 404908 404921 404924 404935 404939 404947
404955 404956 404960 404963 404973 404974 404975 404984 404990 470200
470202 470203 470209 470213 470215 470216 470219 470232 470233 470242
470255 470257 470266 470275 470278 470285 470295 470313 470315 470328
470343 470357 470385 470444 470447 470492 470514 470554 470589 470723
470765 470778 470800 470865 470881 470885 470999 508222 508226 508228
508234 508248 508251 508254 508255 508259 508261 508262 508277 508320
508330 508336 508341 508347 508357 508362 508366 508378 508380 508384
508385 508393 508397 508398 508420 508427 508430 508432 508450 508453
508456 508457 508473 508477 508481 508485 508487 508490 508523 508528
508532 508543 508548 508561 508564 508580 508584 508586 508587 508612
508636 508638 508646 508674 508675 508678 508693 508735 508748 508760
508769 508775 508785 508787 508824 508829 508832 508835 508836 508842
508845 508853 508855 508864 508865 508866 508867 508868 508869 508877
508883 508885 508886 508892 508896 508910 508943 508947 508991 508992
508993 508994 508995 508996 508997 617233 617268 617269 617270 617274
617290 617304 617308 617312 617323 617327 617333 617361 617374 617387
617388 617413 617429 617436 617445 617447 617448 617453 617458 617461
617471 617472 617474 617475 617479

[IPP]

Buna ziua

Ar fi bine sa atasati un fisier exemplu in excel.

Se poate lua in considerare si o prelucrare fara macro.
-Daca informatia o aveti aranjanta asa ca urmare a folosirii unui pivot table si folositi o versiune de excel >=2010 atunci prima cerinta o puteti rezolva direct din pivot table (Shwo in Tabular form respectiv Report Layout, Repet All item labels); daca nu, se poate insera o coloana ajutatoare si pune o formula care sa faca completarea respectiva
-Se insereaza inca o coloana ajutatoare in care sa se faca concatenarea valorilor. Aici, in functie de versiunea de excel pe care o aveti, poate aveti nevoie de o singura formula sau de mai multe, imbricate.
-la final se salveaza informatia ca valori in alta parte iar fisierul unde s-a facut prelucrarea se poate folosi ca sablon (cu eventuale modificari ulterioare)

IP

[IPP]

Buna ziua

Atasat aveti spre testare o prounere folosind macro.
Obiectiv: scrierea informatiei intr-o foaie dedicata (numita in fisierul meu Prelucrat) pe doua coloane: A - pentru label si B pentru informatia concatenata, separata prin virgula.

Premise:
Nu se redenumesc foile implicate (sau se va edita codul)
Daca informatia bruta trece de 65536 de randuri va trebui editat in cod cu o alta valoare mai mare
Informatia va incepe intotdeauna din A1 (foaia Brut) si va avea structura si completarea din modelul atasat (adica fara celule goale in afara de cele de pe coloana A)

Am folosit urmatorul cod

Cod: Selectaţi tot

Sub PrelucreazaInfo()

'IPP - 06.06.2020

Dim myResult As Variant
 myResult = ""
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
Sheets("Prelucrat").Range("A1").CurrentRegion.Offset(1, 0).ClearContents

Sheets("Brut").Select
Range("A2").Select
Do Until IsEmpty(ActiveCell.Offset(0, 1))
 If IsEmpty(ActiveCell) Then
  ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
 End If
ActiveCell.Offset(1, 0).Select
Loop

Range("B1").Select
Do Until IsEmpty(ActiveCell)
 Do Until ActiveCell = ""
  myResult = myResult & ActiveCell.Value & ","
  
  ActiveCell.Offset(0, 1).Select
 Loop
 
 With Sheets("Prelucrat").Range("A65536").End(xlUp).Offset(1, 0)
 .Value = Cells(ActiveCell.Row, 1).Value
 .Offset(0, 1).Value = "'" & Left(myResult, Len(myResult) - 1)
 End With
 
   myResult = ""
Cells(ActiveCell.Row + 1, 2).Select
Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Pentru testare: deschideti fisierul atasat, activati macro/continutul, rulati macro.

IP

[madalina.petre]

Buna ziua,

Am atasat un exemplu de fisier. Datele din primul sheet trebuie aduse la forma din Sheet2. Numarul de label-uri este variabil, la fel si cel al codurilor asociate unui label. Multumesc!

[IPP]

Buna ziua

Aveti atasat spre testare un fisier (fisierul a fost creat si testat in Excel 2010)

Fata de ceea ce am spus in mesajul anterior mai trebuie avut grija la:
-in foaia Brut sa nu existe absolut nicio informatie decat cea de interes, deci inainte de orice, selectati toate celule din foaie si apasati Delete, apoi aduceti informatia respectiva.
-numarul de coduri asociate unui label nu trebuie sa depaseasca 16000
-am presupus ca numarul de coduri de pe un singur rand nu va fi mai mare de 59; daca e cazul va trebui modificat.

Am folosit urmatorul cod

Cod: Selectaţi tot

Sub PrelucrareInfo_2()

'IPP - 10.06.2020

Dim destinRow As Long
Dim destinClm As Long

Dim myResult As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Final").Range("A1").CurrentRegion.Offset(1, 0).ClearContents

Sheets("Brut").Select
Range("B1").Select
 
Do Until IsEmpty(ActiveCell)
 If ActiveCell.Offset(0, -1) <> "" Then
  destinRow = ActiveCell.Row
 End If
 If ActiveCell.Offset(0, -1) = "" Then
  destinClm = Range("XFD" & destinRow).End(xlToLeft).Offset(0, 1).Column
  Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 60)).Copy Destination:=Cells(destinRow, destinClm)
End If

ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select
Do Until IsEmpty(Cells(ActiveCell.Row, 2))
 If Cells(ActiveCell.Row, 1) <> "" Then
  ActiveCell.Offset(0, 1).Select
   Do Until IsEmpty(ActiveCell)
    myResult = myResult & ActiveCell.Value & ", "
   ActiveCell.Offset(0, 1).Select
   Loop
   myResult = Left(myResult, Len(myResult) - 2)
 End If
  
 
 With Sheets("Final").Range("A65536").End(xlUp).Offset(1, 0)
 .Value = Cells(ActiveCell.Row, 1).Value
 .Offset(0, 1).Value = myResult
 End With

   myResult = ""

Cells(ActiveCell.Row + 1, 1).Select
Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Acesta:
-sterge in foaia "Final" rezultatul unei eventuale prelucrari mai vechi
-parcurge coloana cu Label si copiaza toate codurile asociate pe acelasi rand cu cel care contine numele etichetelor
-parcurge din nou lista, colecteaza codurile asociate fiecarui label si scrie rezultatele in foaia Final

IP

[madalina.petre]

E perfect! Multumesc frumos!