Ускорить работу кода с большим количеством циклов

Question

Есть следующая задача в vba-excel:

Происходит выборка блоков в Автокаде и затем запись в столбцы Excel 2х значений - имя Тэга атрибута блока (*autocad), ячейка A1 и его текстовое значение, ячейка A2. И так по всем блокам в выборке.

При этом, сначала прописываются (с проверкой на уже записанные в столбцах) имена тэгов в столбцы. А затем в соответствии с именем тэга прописываются текстовые значения этого тэга.

И каждый раз это циклы For..Next.

Подскажите пожалуйста, как можно оптимизировать для большей скорости подобные процедуры: с помощью массивов, классов и коллекциями?

Пример кода:

For Each lBlockObj In objSelectionSet
      Set lBlock = acadDoc.SelectionSets("TempSSet").Item(I - 1)
           
        varAttributes = lBlockObj.GetAttributes
    
'добавление имен тэгов здесь без проверки что уже есть
        For n = LBound(varAttributes) To UBound(varAttributes)
          Cells(2, at_hed).Value = varAttributes(n).TagString
          at_hed = at_hed + 1
        Next n
    
    'запись атрибутов
    For r = 2 To Col_N1
      For n = LBound(varAttributes) To UBound(varAttributes)
        If varAttributes(n).TagString = Cells(2, r).Value Then ActiveCell.Offset(0, r - 2).Value = varAttributes(n).MTextAttributeContent
      Next n
    Next r
    
    ActiveCell.Offset(1, 0).Activate
    
        Set lBlock = Nothing
      Next lBlockObj

Answer 1

Решение

Предлагаю вам такое решение (предполагается, что ни существующие, ни новые блоки не отсортированы по тэгу, в противном случае соответствующую сортировку нужно удалить):

Sub Solution(varAttributes As Variant, Tgt As Range)
  Dim ts As Worksheet, a, r, rr, rso, aso, i&, j&, k&, x, al&, rl&, m As Boolean
  With Application
    rr = .Transpose(Tgt.CurrentRegion.Rows(1))
    If IsArray(rr) Then
      rl = UBound(rr, 1): rso = .SortBy(Evaluate("SEQUENCE(" & rl & ")"), rr)
    Else
      rl = 1: ReDim rso(1 To 1, 1 To 1): rso(1, 1) = 1
    End If
    r = Tgt.CurrentRegion: Set ts = Worksheets.Add: i = 0: j = 1: k = 1
    For Each x In varAttributes
      i = i + 1: ts.Cells(i, 1) = x.TagString: ts.Cells(i, 2) = x.MTextAttributeContent
    Next
    al = i: Set rr = ts.[A1].CurrentRegion: a = rr: ReDim na(1 To 3, 1 To al)
    aso = .SortBy(Evaluate("SEQUENCE(" & al & ")"), rr.Columns(1))
    .DisplayAlerts = False: ts.Delete: .DisplayAlerts = True
    For i = 1 To al
      For j = j To rl
        If StrComp(a(aso(i, 1), 1), r(1, rso(j, 1)), vbTextCompare) <> 1 Then Exit For
      Next
      If j <= rl Then
        If a(aso(i, 1), 1) = r(1, rso(j, 1)) Then
          r(2, rso(j, 1)) = a(aso(i, 1), 2): j = j + 1: GoTo Continue
      End If: End If
      na(1, k) = a(aso(i, 1), 1): na(2, k) = a(aso(i, 1), 2): na(3, k) = aso(i, 1)
      k = k + 1
  Continue:
    Next
    Tgt.Resize(2, rl) = r: Tgt.Offset(0, rl).Resize(2, k - 1) = .Sort(na, 3, 1, True)
  End With
End Sub

Процедура Solution принимает два параметра:

Массив новых блоков. Элементы массива - объекты, у которых есть, как минимум, свойства TagString и MTextAttributeContent строкового типа.
Левая верхняя ячейка диапазона, где находятся данные о блоках (в первой колонке должны быть названия строк или любое содержимое). Блоки могут и отсутствовать, должна быть только первая колонка.

Первоначальный порядок блоков сохраняется.

Работает очень быстро даже на больших объёмах данных (миллионы записей, хотя колонок всего 16384). Вам бы блоки по вертикали разместить.

Тестирование

Option Explicit

Sub test()
  Solution GetAttributes, Sheet2.[A2]
End Sub

Function GetAttributes()
  Dim col, a As ACADAttribute, cl&, i&
  cl = Sheet3.[A1].CurrentRegion.Columns.Count: ReDim col(1 To cl)
  For i = 1 To cl
    Set a = New ACADAttribute
    With Sheet3.[A1].CurrentRegion.Columns(i)
      a.TagString = .Cells(1): a.MTextAttributeContent = .Cells(2)
    End With
    Set col(i) = a
  Next
  GetAttributes = col
End Function

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ACADAttribute"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public TagString$, MTextAttributeContent$

Для тестирования запускать test. Sheet3 у меня - это просто тестовые новые блоки. Среди них есть и существующие, и новые. Тестовые новые блоки считываются функцией GetAttributes, реализация которой вам не нужна. У вас новые блоки в массиве varAttributes.

Тестовые данные - Sheet2

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
TagString;TR3978;CN1088;MJ3547;HX4530;MY1917;YQ2577;CZ3770;RM3213;IU3909;XH4116;CW2544;UE3733;CX2950;HN1611;CC4780;UC3666;UP1913;RT1592;FF4140;RQ2775;OO4557;CI2154;XU2854;JI1712;AQ1397;QA1927;NN1660;RM2115;AK4395;GK2375;GM2522;XT4066;YT3638;CU3116;JV4199;MH3979;KQ4534;VD3671;EQ3947;XY2979;VA2444;KR1263;NC1915;FF1587;VE1860;FP3955;PN4496;PU4508;JS1236;ID2910;IM3979;CQ2573;EM4706;KX1376;BN2129;NK4173;ZK2356;NB3713;QK1681;LL3217;BL1126;GJ4084;CW2909;TD2549;IX3395;JL4494;DV4795;NY2440;UK1831;ST2581;UX3908;QD1220;VX3179;KC1430;QR3764;JK2488;BZ4171;FP2441;GO1810;UX3700;YX2214;MZ3299;PY2909;LK1097;GU2700;EA1378;LS1835;IX1224;WI4515;BR3747;WG1335;MV2927;MM4177;UL3287;DS3486;XW3762;FK4438;RF4302;FL4268;CG3989;BI1571;YQ3319;YW3122;ST4510;PF2870;MM4798;BS3722;DM3248;LH3575;IK1069;LU4584;EJ3282;HC3588;EV1497;GF3229;ZD3840;RI1737;NA1806;GO3252;DM1700;XV4078;ZS4585;MF1055;BK1695;CA4908;BA4183;JQ3068;XL3280;WJ2030;AV1095;JJ1590;VP4674;RM1519;LE2686;EO2793;IU1888;XS4578;JR4189;VS4098;BO3743;TR4805;ZR3939;SR4983;OP4141;FX4797;FC3832;AE2340;BT4856;PJ4228;EO3347;IW1624;NW4941;TY3137;TY3950;DC1976;MW4817;IJ4937;DO4605;DN1300;ZJ4791;YA3040;PM3369;TK1567;ZH4634;AF4207;CC1607;FI3765;RN4573;KG1763;GT1092;LD2391;GA4181;QE2013;UD1298;RD1151;MK4674;WG3044;RH1663;ND2021;WQ2005;RY4298;JM4150;QF4023;AH1202;RM3798;HM1347;PC1075;PV3339;HB2922;IK4178;KL2274;XJ3392;HH2748;ED3081;CV3590;VQ4696;PF4770;CL3389;VN3344;BM4869
MTextAttributeContent;KXWDL idgalqx;YXOBF vxbmzwf;MGCCK eerhvbn;;MLETX itjhlvp;VJEUX eoeriab;;;NOWAM txdwxpz;LMIDZ cvbnykh;;YTZWJ zhhsrfg;;;PZCKU dqgnmzk;JWAVH zqoiorp;HYEHF rzoqbqq;;ZAHQO cnqyfob;;KICXR lfthvjg;;LIUVV wfdddgj;OXUGE twcjxxa;AMHMR wlknfpm;;JSYCD wlnxzck;;IDGJG cbqsqql;YMRLN iskzmvx;RBBFB lhtdwmq;OINKN grsijyy;WLJDL oruyenp;JVSYC jrjbcvo;LMFCE fghpoul;;OHBGK rdqhhlp;PIJQS vgjvezy;AOICG honbbyu;XENDY gyuhzrx;WHRXG cyyrsky;DWGOG rglvarv;GIVDV jjwnlam;HMOQF ozhedzf;;EEBFE ynbpaiu;QVAPI cxyynga;NTKFH qboghvo;IDNWP gmfpcgo;;;AKKPA aclkglc;MNAYX snfhggx;ZNBLU nkmfpzu;TVYEQ vitkqqj;HFDOU vbladmk;TBVXO mzapaef;;QQIHF hdvwfgd;JWRER ueyngxk;LCMJL rmarzhg;NEDTA apduwcf;XKGIK ifnqqos;EHBAB tjqeyeh;;KWWDJ jxqhfjl;QMIEQ oxgwnhv;;DTEHU ifwsiri;QWNMR tdjbtwz;;;QKYVD iyyprgx;ORJQA dxnmocw;;EUKRK xflyaci;UNUNI ecjgfsv;TMVWQ jxgftri;DTBTJ hhpsybh;IWFCG qtugtpt;;FFKBD vqjxrow;DMRKJ ybocbqm;XBVQV otzoawm;PZVTO xxjrfwb;UGOPX xfvzaae;MMPTS ndkllli;PZBSE hnpcqrz;YAKVY eamngez;CMVKZ nzwwqvm;EUNCS vgeoacc;YXBIX senimpy;YPIAE grjcwng;IVCEI jsuwdys;ARGZC ncoybom;BJYTQ xdbwgxp;BCPSA vmpddzv;;WNSKM vgxecfm;;NIPJF capegdp;IPQQW uosdriu;FNUOY weigwuy;ZLHET hkwiigv;;;ZXGVU wutgbvr;DSFZY oxfaavy;HARPC pokjvdy;VLBQU oenmani;SWFPW kqkkxpo;;QYBUZ xsvowaa;RCTER ytmppsj;UJRAN rcamrpm;MOQXM krrviam;ZBJIX wteukpf;CKRZP kszwjvi;;JWFQS nplycrb;JZDGK cnnekkb;PSSAH xvoxwzs;EBPMF hpqgdae;EZNKM xqeibdb;JTYNF mngmkfn;UILTD cfiglcr;ZREHD vexdvee;;HMOBJ apccpcb;;LBPLJ qkwzrec;;EMGSZ qhewncs;NRDFN qcndrlq;RYUPI dftifol;NGQVH xrrrysg;VGNPT oczsvrg;PJBTI gqqlnay;ETHSR vnjtjqp;EVDES luercwc;OBKLH idxjbkm;LZIHZ dsumqlr;WUGFC gxixlzx;MZBWT ppbrhnf;KCNQD gemcejm;;NIEBC zddjxho;YCEKJ icktlql;YDMZL apozzlw;;YHXJS ogwytje;OLZBT ttryzbd;;ZCXBQ yusqdok;FDTDH blpjztu;LLWMR luairrs;TCWUR gmbgwdb;;BUONX wbslxhf;;QRMMF pxcapgq;JRRGO pypsjub;QRSPR bvfwgwj;ZHXZZ smmctqb;YAQAK khxppqz;LIDHV nzriile;ODCQH jhqvmdq;;QNGIO zveztow;ARATV fuslczv;XMPJI ikxsnzf;IZBBV ywziwzs;;XAOBA xfhhtju;XADIB dfqhwhe;;RANFZ tbkirdf;XBCAE ppgivmo;PEXBP hcnogkz;;WSWUD mubndem;KFRUM rpwumst;SWZHA ccelcxq;HPTHV lpsugun;YWKJO mhqooqd;ELJLA lwtoudo;GPHVV shrhfvu;EFLSM itchzcg;TAIWY rfygpcw;CCCBB gihkzlo;WVDEB byibqwi;CEWSM uyknnen;PDWCF pfkpyzs;YYXQB blzwlvv;IXOBS nhcxvcf;UNLLM cerkhwd;QNQPS coxkkrm;BRBHS unxlyxt;;

Sheet3

KL2688;WQ2005;MH3979;FW3246;WH3741;KM3111;PK2797;ZJ4791;MJ3965;ZA2447;IM3979;XI3110;NA1138;SR4808;DF4903;VS1207;UX3908;GM4005;RZ4446;BC4718;KY3176;YX4663;RO1592;VB1036;LT1628;QD1220;AA3047;RR2828;BC1167;RN4573;HV4669;LG4532;VN3344;QR3764;GK1274;MR3889;MT2079;HG1960;MY4375;PF2870;HV4219;AF2441;AO2870;PB3713;UY1758;AV1095;GO2365;DO4605;VE1860;KL3229;ZV2634;KS3957;LR1578;UR4868;AE2598;CW2544;RO2044;SE2354;SV2928;GL3706;ML4235;JK1827;BC2933;EA1375;YV2211;RM3213;XN2734;WU4533;GO3252;RQ2775;PP4885;HX4530;EJ3282;NX1548;MQ4971;EI2815;JC2982;WI3367;YU4366;RE4420;QE2013;PU3599;PI3554;CK3168;MA1373;PG1224;YP4249;LV3837;SQ4389;HW1315;TY1679;RF4302;HO2807;RW4308;ST4794;PU1888;HP1897;CZ3770;ZB3823;NV2535;VF4244;QK1684;RE2087;BM4869;IX3713;MW1209;VI4087;MJ4282;SI2638;PT2005;MM4798;DM3218;CE2578;KD4921;GP2754;SZ1185;MQ1554;IY3947;NT1740;TA4542;BX2191;BK4421;UZ3267;JL1446;QC3527;JQ3816;UJ4414;WW2999;PI3555;QA1772;NY2440;KB1696;VT2490;RK3811;LA1170;CQ4171;GW4688;HH1206;TD3191;CD3011;WL4625;BG1758;ZY4161;BY4549;EG2734;AB4418;FC3832;IU3016;EO1569;JV3032;XO2471;AF1975;MV4794;LN1768;LF2999;RM2115;CI2154;XM4792;AS1937;HB4187;YX4732;NV1811;TU4287;EO3347;FR1349;SQ1870;HV1319;WD3315;MK4674;EZ3203;IX3395;OU1629;MX4092;TD2691;WF4173;JI3757;BZ4265;YX2214;SC3187;XX4202;FL3472;BU2136;SS2691;AI2096;SR4705;QC4624;KZ1831;SL1133;OT3575;OD1103;JK2545;HN1611;LS2499;FZ3454;CT2858;HL2018;GH1962;BI1835;AQ1518;WB2881;BX1847;PZ4714;ID2910;WR1710;TY3137;NN1978;LQ4543;YG1488;CV2519;VP4674;IW2132;XJ2550;HB4798;JY2368;LH1902;IG1608;YM2802;NT1323;RT1592;BZ1182;XL3280;TV2519;MY1465;UT3686;RT1773;MO1668;LS2006;TE2792;JJ4335;QA1927;EF1170;DB3366;NH4565;QN1709;CG3989;YS2242;UB2826;QM4235;CX2950;HS1014;NB3713;MU4670
NQGFW wqoviof;VCEYF fipfsdj;EFORN umnaaop;BMAAF hnwtyaz;PUAVY nlyeidr;HNZXG wdheubh;NUGMW ukiqofv;TRIZD kumbcnc;LVROH beejlno;UZETX jwlabiu;EPRTV pftzhga;SHNNX ecfsqbg;KBOST qjrwudb;RDLTP gafrlwf;ZEVGA uptffsx;RAMDK fqgvurs;XSWZH esixwgm;TUTHD mxequrz;VPOPV haxcxje;FXGVL vvwcnbl;IETVW shntlva;BHLJK xhjzjnx;KJWVU xidtprg;AQKNX qeavxgu;LZENG zovtggn;NZIWH upurokr;BLCHH fcgxwln;VVJBZ ritfppc;VAMPN pbjrxoi;ODTRK ffkkyyc;FGIBA jowniqo;TIYEM aaozoce;CZWDK vkjazkn;DWBSW ijwkite;IVVEW lsgmctt;VRBLI wsdeeee;KBFPL ggxqqqf;ZUSWN ploklrz;SHHDV lzjabah;DUAFI mqybcnl;QFOXF hmpidkf;NNXUU znmqpns;IGYJM pcvdhbq;MJYFA bpdqkmg;SPMUX pojcvyd;JULYO nutktnh;KSPOT cywkcqv;BDPIH dbdynvy;MQQCO ojcmpwk;NNPIO zplhjem;GWXTP suwhcqa;FNIFM mmvzkxf;BVSQF ivamqbz;BSPCB grdiues;EHYSC oiykulq;VZBPM fcbcpou;LMMRF ksvhcoi;SOFFJ qjcwiuw;XGMFL jheffvp;FHBAH robiesb;PCBDH uupavyi;NTRYM nbjtqdg;ODSOU yeamyvf;JPDLB kdjhdiq;VAFPM fzispsv;ETMIV lnppljw;TTWLY huqonvu;PFZZI vxrmmur;SZLZL rhcdife;PDGMT mznjtoj;EULHS tkoqelw;HUOZI zfabvgt;ZXRVM khmbxvk;XHDDW bxibsve;DCTRO upylckj;AUSCS nbtaere;ZWWDF kftcfsn;VYLCP lqevfur;RQMOJ hilhpmw;DFSSN xryzctw;BVSJY cccofmz;VWGTF niniczx;WQMWY ruwooba;MUHLM eckpkwz;YSLMT ihvxizo;ALVNO huoqzcc;VVYXY rgltwaj;NBWHZ ealxijj;WHENU zqlkoak;UICOH xzjqeek;KLWNY gstjqyn;UIBLB yamxkcx;FZZNO ukvmpki;AHALO ciwpzdj;IXWTX uxcynjv;CAFDE oeclhwo;NQTXE ltlnori;RUBCR odebtis;RTNLO bhtyykf;OLQYX szfsxsy;TDDDK iqqqrnn;RDVEO xprjten;NQRAR diqhacn;AQVCL orcidnx;SJVQY becwaiq;KSVUP pgojusx;XUSXJ cqkyytv;FBHCB lmdzpee;OYMLY zylteya;TAIBE evfzvlz;TKCGV uiejnjb;WSHQK hmtjdpo;WIOUW moammyn;PIHDF grrfxun;PWLHW rwhsuaw;EWLXN mivhxez;IULCW jcjydrj;MZOTA kydkxoz;ZOWRS iwlcxey;DEMZV ijcjrat;MMNTQ cydvjza;WZJZX ircghzp;GADDG tkbiydk;EHWVU tqgyvrc;FFMIC afudqbs;HNEMP jharial;CUNPP ojkjvne;GMSGA xtwlqci;ZVWLH mzuwhyy;RGGDS yicheeh;OLUYJ zysdmkh;LGTMA lvntpjx;SCGLK nypavdz;BCSZB objwhbi;NOVEM ylcqljp;YTJDR nniqdop;TAOAW dybnszj;TCNOV uiaiqso;QOLXB xvdjoll;XLEDX ymcatrg;DSAXT alafnkq;BYVIQ peffpuk;HHJJR poeczpq;SWEQG vfbskkm;VIWEW izwyltu;YHKND uhizsgb;REEYE kfcrnny;ZIRWJ hzpvqft;ESLHL ipxlinr;QXQHL vjohgcp;HUMEK zosvbqb;OUELH ygfyqsm;CPUVC douulbv;QPWTK xuxfmgg;OCVBX ayfsmmw;ENUJK ouaghmj;KXFUG pggnvxb;VSUZQ guletnz;LGETI pugnmzj;POCOJ diaqxtw;UGUAR ijenpcl;OZPSY farxlho;ZISBL zwkftdd;HIEGI vrybtxs;TOTSP aupjylh;VZNUK daxlvok;NZZLL gbaqcrz;UYSOU zakvxxs;FIZOV jfnbitx;FMLNN uyfztfd;GJHEC dmoksbr;MRIQR nysmudn;IVRKE wxesqkd;GKKSY vlmvzmf;ZJMUD obpirlj;FZIMI tmwfjdy;JCQXV jppqliv;MKLLO ulxsryu;DOASV qcdgjvy;GPHXL isrbslj;XUSDK jtwclfc;EDLXO hrxyezx;ILUMG bnigusv;XVIEA vizojjw;LOZZO dyzsefc;EWEBY xgidapr;GDIMH usvdlnm;CPLBB gefbtrf;DOAFU qbzagdm;RPQEK rkhouhu;LFRXR tgsuqhf;HYPOV qkuiwph;XVWWC dazisff;TSUCV jtyycny;WUUFY xzrmsym;KPHQJ ybteyzw;QQMVY ofgjjoj;IMCTM xhotvoq;MGVEX ekzoyho;HFZSL jincswt;HKYJU mjjijhu;PSEPD ypcgvjo;GMESK lbffwre;HILES emqxjfs;SZJVZ txsuvhl;VFJNJ lxookox;GDJVH uzswggp;WKVCV dnqbqax;HSJXB nfzyikd;TOKHH jxcbbqy;PFSLF kxrsqvp;XRZZS hbivrwq;CZMVR ehikpcu;VNHSY lvcpgok;OUCTO pxeoazl;EYZBM vqaajsg;REWUF pzdjswj;HHVZO ujnjycq;MVGLF ieeimaq;VLRCT epvuhnr;JKRRV ssopfon;PRESI jiiexno;REWXK dbcrnrw;AVWCT egdqdmf;PUHHZ smqrpyr;VIQVG ibolqfr;LURAG mbqjfdd;FUQUV rbaykoo;MFCOP yajslce;GYFDA gmwtpry;XRBPY ylelhal;OCOVB lsbrdol;VEFOV pfcneee;GPIKW qlnfgpi;VGVPM qfogcvu;JWLPL lfbmwdp;LPBKK gcvjrys;HILOP bqzxswa;LRCTL wajifwb;CWNKY lrslplc;VDSWX ixyxmvr;PFURX bsenhfh

БЛОГ НА HUSL

Ускорить работу кода с большим количеством циклов

Ответы (1 шт):