Function SelectCells(AA As Range, FLTR, FLTR2) As Object 'конечный вариант - самый быстрый на больших количествах ячеек - подумать над оптимизацией
Dim i&, j&, k&, addr$, addr2$, s(1 To 870) As Range, x&, y&, t#, xEnd&, yEnd&, aa1, L&, CName$(), c&, UR, UR1, n, VF, ac
'With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: ac = .Calculation: .Calculation = -4135: .StatusBar = "BVV: обработка данных...": End With
Set AA = Intersect(AA, ActiveSheet.UsedRange)
xEnd = AA.Rows.Count 'задаем границы диапазона строк
yEnd = AA.Columns.Count 'задаем нижние границы диапазона столбцов
ReDim CName(1 To yEnd) ' Создать массив имен столбцов
For c = 1 To yEnd
CName(c) = Split(Cells(1, c).Address, "$")(1)
Next
aa1 = AA.Value
For y = 1 To yEnd
For x = 1 To xEnd
'========================================
VF = aa1(x, y)
If IsError(VF) Eqv IsError(FLTR) Then 'обработка ошибок (в ячейке и условии)
If VF Like FLTR Then 'If VF like FLTR And Not VF = FLTR2 Then 'ЗАДАЕМ УСЛОВИЕ
'========================================
If addr = "" Then
Set UR = AA.Cells(x, y)
Set UR1 = AA.Cells(x, y) 'UR.Address(RowAbsolute:=False, ColumnAbsolute:=False)
For i = 1 To 870 ' Создать буферный массив для накопления адресов
Set s(i) = UR1
Next
i = 1 ' Начальный указатель в буфере
End If
addr = CName(y) & x: L = Len(addr): k = k + L + 1 '+1 это запятая. K-количество знаков для Range
If k > 256 Then Set s(i) = AA.Range(addr2): addr2 = addr: k = L + 1: i = i + 1
If k = L + 1 Then addr2 = addr Else addr2 = addr2 & "," & addr
If (i = 870 And k > 245) Then ' При заполнении буферного массива до 32915 ячеек - Union-страшная функция)))
Остаток:
Set s(i) = AA.Range(addr2)
's(870).Select
Set UR = Union(UR, Union(s(1), s(2), s(3), s(4), s(5), s(6), s(7), s(8), s(9), s(10), s(11), s(12), s(13), s(14), s(15), s(16), s(17), s(18), s(19), s(20), s(21), s(22), s(23), s(24), s(25), s(26), s(27), s(28), s(29), s(30)), Union(s(31), s(32), s(33), s(34), s(35), s(36), s(37), s(38), s(39), s(40), s(41), s(42), s(43), s(44), s(45), s(46), s(47), s(48), s(49), s(50), s(51), s(52), s(53), s(54), s(55), s(56), s(57), s(58), s(59), s(60)), Union(s(61), s(62), s(63), s(64), s(65), s(66), s(67), s(68), s(69), s(70), s(71), s(72), s(73), s(74), s(75), s(76), s(77), s(78), s(79), s(80), s(81), s(82), s(83), s(84), s(85), s(86), s(87), s(88), s(89), s(90)), Union(s(91), s(92), s(93), s(94), s(95), s(96), s(97), s(98), s(99), s(100), s(101), s(102), s(103), s(104), s(105), s(106), s(107), s(108), s(109), s(110), s(111), s(112), s(113), s(114), s(115), s(116), s(117), s(118), s(119), s(120)), _
Union(s(121), s(122), s(123), s(124), s(125), s(126), s(127), s(128), s(129), s(130), s(131), s(132), s(133), s(134), s(135), s(136), s(137), s(138), s(139), s(140), s(141), s(142), s(143), s(144), s(145), s(146), s(147), s(148), s(149), s(150)), Union(s(151), s(152), s(153), s(154), s(155), s(156), s(157), s(158), s(159), s(160), s(161), s(162), s(163), s(164), s(165), s(166), s(167), s(168), s(169), s(170), s(171), s(172), s(173), s(174), s(175), s(176), s(177), s(178), s(179), s(180)), Union(s(181), s(182), s(183), s(184), s(185), s(186), s(187), s(188), s(189), s(190), s(191), s(192), s(193), s(194), s(195), s(196), s(197), s(198), s(199), s(200), s(201), s(202), s(203), s(204), s(205), s(206), s(207), s(208), s(209), s(210)), Union(s(211), s(212), s(213), s(214), s(215), s(216), s(217), s(218), s(219), s(220), s(221), s(222), s(223), s(224), s(225), s(226), s(227), s(228), s(229), s(230), s(231), s(232), s(233), s(234), s(235), s(236), s(237), s(238), s(239), s(240)), _
Union(s(241), s(242), s(243), s(244), s(245), s(246), s(247), s(248), s(249), s(250), s(251), s(252), s(253), s(254), s(255), s(256), s(257), s(258), s(259), s(260), s(261), s(262), s(263), s(264), s(265), s(266), s(267), s(268), s(269), s(270)), Union(s(271), s(272), s(273), s(274), s(275), s(276), s(277), s(278), s(279), s(280), s(281), s(282), s(283), s(284), s(285), s(286), s(287), s(288), s(289), s(290), s(291), s(292), s(293), s(294), s(295), s(296), s(297), s(298), s(299), s(300)), Union(s(301), s(302), s(303), s(304), s(305), s(306), s(307), s(308), s(309), s(310), s(311), s(312), s(313), s(314), s(315), s(316), s(317), s(318), s(319), s(320), s(321), s(322), s(323), s(324), s(325), s(326), s(327), s(328), s(329), s(330)), Union(s(331), s(332), s(333), s(334), s(335), s(336), s(337), s(338), s(339), s(340), s(341), s(342), s(343), s(344), s(345), s(346), s(347), s(348), s(349), s(350), s(351), s(352), s(353), s(354), s(355), s(356), s(357), s(358), s(359), s(360)), _
Union(s(361), s(362), s(363), s(364), s(365), s(366), s(367), s(368), s(369), s(370), s(371), s(372), s(373), s(374), s(375), s(376), s(377), s(378), s(379), s(380), s(381), s(382), s(383), s(384), s(385), s(386), s(387), s(388), s(389), s(390)), Union(s(391), s(392), s(393), s(394), s(395), s(396), s(397), s(398), s(399), s(400), s(401), s(402), s(403), s(404), s(405), s(406), s(407), s(408), s(409), s(410), s(411), s(412), s(413), s(414), s(415), s(416), s(417), s(418), s(419), s(420)), Union(s(421), s(422), s(423), s(424), s(425), s(426), s(427), s(428), s(429), s(430), s(431), s(432), s(433), s(434), s(435), s(436), s(437), s(438), s(439), s(440), s(441), s(442), s(443), s(444), s(445), s(446), s(447), s(448), s(449), s(450)), Union(s(451), s(452), s(453), s(454), s(455), s(456), s(457), s(458), s(459), s(460), s(461), s(462), s(463), s(464), s(465), s(466), s(467), s(468), s(469), s(470), s(471), s(472), s(473), s(474), s(475), s(476), s(477), s(478), s(479), s(480)), _
Union(s(481), s(482), s(483), s(484), s(485), s(486), s(487), s(488), s(489), s(490), s(491), s(492), s(493), s(494), s(495), s(496), s(497), s(498), s(499), s(500), s(501), s(502), s(503), s(504), s(505), s(506), s(507), s(508), s(509), s(510)), Union(s(511), s(512), s(513), s(514), s(515), s(516), s(517), s(518), s(519), s(520), s(521), s(522), s(523), s(524), s(525), s(526), s(527), s(528), s(529), s(530), s(531), s(532), s(533), s(534), s(535), s(536), s(537), s(538), s(539), s(540)), Union(s(541), s(542), s(543), s(544), s(545), s(546), s(547), s(548), s(549), s(550), s(551), s(552), s(553), s(554), s(555), s(556), s(557), s(558), s(559), s(560), s(561), s(562), s(563), s(564), s(565), s(566), s(567), s(568), s(569), s(570)), Union(s(571), s(572), s(573), s(574), s(575), s(576), s(577), s(578), s(579), s(580), s(581), s(582), s(583), s(584), s(585), s(586), s(587), s(588), s(589), s(590), s(591), s(592), s(593), s(594), s(595), s(596), s(597), s(598), s(599), s(600)), _
Union(s(601), s(602), s(603), s(604), s(605), s(606), s(607), s(608), s(609), s(610), s(611), s(612), s(613), s(614), s(615), s(616), s(617), s(618), s(619), s(620), s(621), s(622), s(623), s(624), s(625), s(626), s(627), s(628), s(629), s(630)), Union(s(631), s(632), s(633), s(634), s(635), s(636), s(637), s(638), s(639), s(640), s(641), s(642), s(643), s(644), s(645), s(646), s(647), s(648), s(649), s(650), s(651), s(652), s(653), s(654), s(655), s(656), s(657), s(658), s(659), s(660)), Union(s(661), s(662), s(663), s(664), s(665), s(666), s(667), s(668), s(669), s(670), s(671), s(672), s(673), s(674), s(675), s(676), s(677), s(678), s(679), s(680), s(681), s(682), s(683), s(684), s(685), s(686), s(687), s(688), s(689), s(690)), Union(s(691), s(692), s(693), s(694), s(695), s(696), s(697), s(698), s(699), s(700), s(701), s(702), s(703), s(704), s(705), s(706), s(707), s(708), s(709), s(710), s(711), s(712), s(713), s(714), s(715), s(716), s(717), s(718), s(719), s(720)), _
Union(s(721), s(722), s(723), s(724), s(725), s(726), s(727), s(728), s(729), s(730), s(731), s(732), s(733), s(734), s(735), s(736), s(737), s(738), s(739), s(740), s(741), s(742), s(743), s(744), s(745), s(746), s(747), s(748), s(749), s(750)), Union(s(751), s(752), s(753), s(754), s(755), s(756), s(757), s(758), s(759), s(760), s(761), s(762), s(763), s(764), s(765), s(766), s(767), s(768), s(769), s(770), s(771), s(772), s(773), s(774), s(775), s(776), s(777), s(778), s(779), s(780)), Union(s(781), s(782), s(783), s(784), s(785), s(786), s(787), s(788), s(789), s(790), s(791), s(792), s(793), s(794), s(795), s(796), s(797), s(798), s(799), s(800), s(801), s(802), s(803), s(804), s(805), s(806), s(807), s(808), s(809), s(810)), Union(s(811), s(812), s(813), s(814), s(815), s(816), s(817), s(818), s(819), s(820), s(821), s(822), s(823), s(824), s(825), s(826), s(827), s(828), s(829), s(830), s(831), s(832), s(833), s(834), s(835), s(836), s(837), s(838), s(839), s(840)), _
Union(s(841), s(842), s(843), s(844), s(845), s(846), s(847), s(848), s(849), s(850), s(851), s(852), s(853), s(854), s(855), s(856), s(857), s(858), s(859), s(860), s(861), s(862), s(863), s(864), s(865), s(866), s(867), s(868), s(869), s(870))) ', Union(s(871), s(872), s(873), s(874), s(875), s(876), s(877), s(878), s(879), s(880), s(881), s(882), s(883), s(884), s(885), s(886), s(887), s(888), s(889), s(890), s(891), s(892), s(893), s(894), s(895), s(896), s(897), s(898), s(899), s(900)))
For i = 1 To 870 ' очистить буферный массив для накопления адресов
Set s(i) = UR1
Next
i = 1: k = 0 ' Начальный указатель в буфере
End If
End If
End If 'обработка ошибок
Next
Next
If k > 0 Then GoTo Остаток 'не кошерно, но короче
If Not IsEmpty(UR) Then Set SelectCells = UR 'UR.Select'
'With Application: .ScreenUpdating = True: .DisplayAlerts = True: .EnableEvents = True: .Calculation = ac: .StatusBar = False: End With
End Function |