根据价值突出细胞,mulptie搜索数组

时间:2015-06-06 23:57:32

标签: arrays excel vba excel-vba

我正在使用VBA查找生活在采购订单编号末尾的某些2或3个字母“用户ID”号码。例如123456DWR。

我有大约1500个不同的“用户ID”号码(DWR)我没有创建我正在使用的代码,但我在搜索阵列行中添加了900个左右的id。

目前,此代码突出显示了/找到ID号所在行的整个行。我只需要突出显示自己的单元格。

我试图让它引用Cell,而不是Cells.Row但它不起作用。

有人能引导我朝着正确的方向前进吗?代码

Sub Affiliates()
   'This code must be updated as affiliates are added or removed
Dim allRange As Range

Dim searchTerms As Variant
Dim cell As Range, word As Variant

Sheets("UPS").Activate
Application.ScreenUpdating = False
Application.Calculation = xlManual
searchTerms = Array("AF2-", "AF3-", "AF4-", "AF5-", "AF6-", "AFP-", "AIP-", "AKB-", "APE-", "ASP-", "AU-", "AU2-", "AU3-", "au4-", "AZ-", "B1-", "BD4-", "BDZ-", "BLS-", "BLT-", "BMK-", "BMP-", "BQ-", "BR2-", "BR3-", "BRI-", "BRT-", "BTU-", "BV-", "BX2-", "BXM-", "BZG-", "CAV-", "CJW-", "CM2-", "CSI-", "DES-", "DGR-", "DXE-", "ED2-", _
"ED3-", "ED4-", "ED5-", "ED6-", "EDA-", "EMV-", "ERR-", "ERS-", "FM2-", "FMP-", "FYI-", "GCK-", "GH-", "GL2-", "GL3-", "GLP-", "GPR-", "GSH-", "HDL-", "HMF-", "HO-", "HW2-", "HWM-", "J33-", "JC4-", "JC5-", "JCG-", "JFG-", "JG-", "JGR-", "JJM-", "JPR-", "JR4-", "JRD-", "JRW-", "JSB-", "JWW-", "KAH-", "KBP-", "KC2-", _
"KCP-", "KM2-", "KMF-", "KN2-", "KN3-", "KNC-", "KP2-", "KPB-", "KRN-", "KRT-", "LKV-", "MB-", "MJP-", "MYG-", "MZE-", "P72-", "PAC-", "PTG-", "PVT-", "RGN-", "S42-", "S44-", "S45-", "S46-", "S48-", "S52-", "S53-", "SA1-", "SA5-", "SAN-", "SD2-", "SD3-", "SD4-", "SD5-", "SD6-", "SD7-", "SD8-", "SD9-", "SHK-", "SKY-", "SMY-", "SN-", "SP-", _
"SPA-", "SQ2-", "SQX-", "SUD-", "SUE-", "SZT-", "TEL-", "TF2-", "TGT-", "THR-", "TMT-", "tpp-", "VN-", "WR-", "WX-", "WX3-", "WYS-", "YM2-", "YM3-", "YM4-", "YM5-", "YMT-", "wdd-""AAA-", "ABT-", "CM3-", "CM5-", "CMG-", "DCD-", "DR9-", "DRB-", "DRW-", "DVW-", "EE-", "EG2-", "EG3-", "EGS-", "EMD-", "EP2-", "EP3-", "EP5-", "EPS-", "EV-", "FAS-", "FL2-", "GM8-", "GM9-", "GMN-", "KR5-", "KR6-", "KR7-", "KRC-", "M33-", "M34-", "M35-", "M36-", "M37-", "M38-", "M39-", "M42-", _
"M43-", "M46-", "M47-", "M48-", "M49-", "MM2-", "MOX-", "MR3-", "MR4-", "MRV-", "MS5-", "MS6-", "MS7-", "MS8-", "MS9-", "MSY-", "MT-", "MUS-", "NM-", "P32-", "PF6-", "PFP-", "PM2-", "PM3-", "PM4-", "PM5-", "PM6-", "PM7-", "PM8-", "PM9-", "PMR-", "RS2-", "RSD-", "RST-", "S62-", "S63-", "SHE-", "SMK-", "SUN-", "SVA-", "Z1-", "Z42-", "ZA5-", "ZA6-", "ZAG-", "ZAH-", "ZDM-", _
"3P-", "AAP-", "AD3-", "AD4-", "AD9-", "ADC-", "ADV-", "AFF-", "AJT-", "ALB-", "AMA-", "AP2-", "AP3-", "APG-", "APM-", "APS-", "ARG-", "ASA-", "AVD-", "AZP-", "BAG-", "BCD-", "BCK-", "BE2-", "BE3-", "BGB-", "BJB-", "BP2-", "BPM-", "BR-", "BTC-", "BTM-", "BUZ-", "BWL-", "C22-", "C23-", "C24-", "CAR-", "CCP-", "CCW-", "CG-", "CGK-", "CLJ-", "CME-", "CP9-", "CPM-", "CPR-", "CPT-", "CPU-", "CRM-", "CRN-", "CT-", "DAV-", "DC-", "DC3-", "DC4-", "DKP-", "DNC-", "DNF-", "DNT-", "DP2-", "DPL-", "DPT-", "DQ-", "DR2-", "DRT-", "E22-", "EI-", "EP-", "FB2-", "FB3-", "FBG-", "FCA-", "FL-", "FLN-", "FNN-", "FPS-", "FVE-", "GA-", "GB2-", "GEE-", "GF2-", "GFS-", "GFY-", "GM-", "GME-", "GN-", "GU2-", "GUS-", _
"HJS-", "JAE-", "JDN-", "JHG-", "JNK-", "JTP-", "JWP-", "JX2-", "KCD-", "KK2-", "KKA-", "KW-", "L22-", "L23-", "l24-", "L9-", "LA5-", "LAX-", "LD-", "LD2-", "LR-", "M44-", "MA2-", "MA5-", "MA6-", "MAJ-", "MAL-", "MD2-", "MD3-", "MDM-", "MK1-", "MKY-", "MM-", "MN-", "MO-", "MP5-", "MPE-", "MRK-", "MTH-", _
"MV-", "MY-", "NA-", "NE2-", "NE3-", "NEP-", "NF-", "NGP-", "NIP-", "NNF-", "NSM-", "OCA-", "OD-", "P62-", "P63-", "PBB-", "PCK-", "PDM-", "PEN-", "PH-", "PHX-", "PLG-", "PMM-", "PMN-", "PNR-", "PPC-", "PPW-", "PSP-", "PST-", "PW3-", "PW5-", "QA-", "QM-", "RAD-", "RAY-", "RE-", "RGK-", "RG5-", "RKT-", "RSW-", "RU-", "RV-", "S27-", "SAM-", "SC2-", "SCG-", "SCH-", "SDC-", "SF2-", "SFL-", "SGE-", "SMA-", "STW-", "TBM-", "TFG-", "THK-", "THY-", "TOG-", "TRC-", "TW2-", "TWE-", "TY2-", "TYB-", "UC-", "UH-", "UP2-", "UP3-", "UPW-", "VB-", "WDB-", "WM-", "WTC-", "WZ-", "XS-", "YN-", "YN2-", "YN3-", "YN4-", "YN5-", "YN6-", "YN7-", "YNG-", "YP-", "YPR-", "ZA2-", "ZAA-", "ZAD-", "STT-", "ef-", "JX-", _
"A2-", "ABP-", "ABS-", "AE-", "AF-", "AJ-", "ALL-", "AM-", "AN2-", "ANS-", "AP-", "APP-", "ASJ-", "ASK-", "ASM-", "ATJ-", "BA2-", "BAA-", "BAM-", "BAS-", "BBE-", "BBP-", "BG-", "BG2-", "BGD-", "BK2-", "BK3-", "BK4-", "BK5-", "BK6-", "BK7-", "BLZ-", "BMG-", "BP-", "BSK-", "BTB-", "BX-", "BYJ-", "CEC-", "CHT-", "CJ2-", "CJR-", "CMB-", "CN-", "COB-", "CPC-", "CPP-", "CTA-", "CWG-", "D22-", "D24-", "D25-", "D26-", "D27-", "D28-", "D29-", "D30-", "D32-", "D33-", "D34-", "D35-", "DAJ-", "DAK-", "DAP-", "DB2-", "DBC-", "DBP-", "DCA-", "DDP-", "DEL-", "DGJ-", "DMJ-", "DP3-", "DPI-", "DRA-", "DS-", "DS2-", "DS3-", "DS4-", "DS5-", "DS6-", "DS7-", "DS8-", "DS9-", "DSN-", "DSP-", "DSR-", "DT2-", "DT3-", _
"DT4-", "DT5-", "DTM-", "EC2-", "ECL-", "EDM-", "ENS-", "ERN-", "ES2-", "ES3-", "es4-", "ESC-", "ESH-", "EZB-", "FDA-", "FI-", "FI2-", "GBL-", "GCR-", "GRR-", "GS-", "GT2-", "GTE-", "HM2-", "HM3-", "HM4-", "HM5-", "HMG-", "HN-", "HNN-", "IA-", "JMS-", "JSY-", "K24-", "K26-", "K27-", "KAU-", "KMK-", "KPN-", "KRK-", "LT-", "MDY-", "MKD-", "MLM-", "MMM-", "MP-", "MR2-", "MR6-", "MRA-", "MRE-", "NAA-", "PA-", "PCS-", "PK2-", "PK3-", "PK4-", "PK5-", "PKG-", "POD-", "PT4-", "PTS-", "RDV-", "RH2-", "RHS-", "RJS-", "SA-", "SBG-", "SEB-", "SJP-", "SL2-", "SLT-", "SQ-", "STC-", "STF-", "SY-", "T99-", "TRY-", "UMT-", "VP-", "VZ-", "VZ1-", "WAG-", "WDM-", "WH-", "YJ-", "STM", _
"A1-", "AMS-", "AN-", "AY2-", "AYW-", "BB-", "BDS-", "BJC-", "BNG-", "BSH-", "BW2-", "BWR-", "BWS-", "CGP-", "CM4-", "CPS-", "CQS-", "CV-", "CWN-", "CY-", "D42-", "D43-", "DPB-", "DTG-", "DTY-", "DV-", "DVD-", "DVE-", "DY2-", "ELR-", "ENX-", "EST-", "FN2-", "FN3-", "FN4-", "FNT-", "FNY-", "FS2-", "FSN-", "GBD-", "GG2-", "GGM-", "GLM-", "GM5-", "GSE-", "HCE-", "HGT-", "HNA-", "HYD-", "IB-", "IE-", "IW-", "J32-", "JBE-", "JEN-", "JLR-", "JLW-", "JN6-", "JN7-", "JN8-", "JNH-", "JV2-", "JVP-", "KA2-", "KBK-", "KNX-", "KPP-", "KPR-", "LC-", "LPE-", "LRE-", "LV2-", "LV3-", "LV4-", "LV5-", "LVL-", "M12-", "M15-", "M19-", "M24-", "M51-", "M52-", "M53-", "M55-", "M57-", "M63-", "M64-", "M68-", "M69-", "M72-", "M73-", "M74-", "M75-", "MCC-", "MCK-", "MHA-", "MJF-", "MKE-", "MMT-", "MP2-", _
"MPN-", "MPT-", "MR5-", "MST-", "MU6-", "MUN-", "NEB-", "NVT-", "NY5-", "PJ2-", "PJM-", "PNY-", "PRV-", "PTM-", "PTN-", "RCG-", "RED-", "REN-", "RH3-", "RN2-", "RND-", "RT2-", "RT3-", "RT4-", "RTC-", "SDM-", "SPP-", "SV2-", "SV3-", "SV4-", "SV5-", "SV6-", "SV7-", "SVN-", "SVS-", "SXT-", "TCB-", "TE5-", "TE6-", "TEE-", "TER-", "TK2-", "TKG-", "TNY-", "TUV-", "VPG-", "VU-", "VW2-", "VWP-", "W25-", "WO-", "WR4-", "WR5-", "WR6-", "WR8-", "WR9-", "WRH-", "WTT-", "Y23-", "YG-", "YK-", "Z22-", "Z23-", "ZAM-", "ZAQ-", "ZAR-", "ZAS-", "ZAU-", "ZFG-", "ZIN-", "ZR2-", "BA-", "BAR-", "BES-", "BLR-", "BS2-", "BSY-", "CD-", "CRT-", "CS-", "CT7-", "CTY-", "CVT-", "CWP-", "CZ-", "DRS-", "DVL-", "EM2-", "EM3-", "EM4-", "EM5-", "EMF-", "EPR-", "EVE-", "FP-", "FSP-", "FST-", "HTT-", "JA5-", "JAC-", "JAN-", "JK2-", "JKH-", _
"BNT-", "DER-", "DWH-", "EL-", "EU-", "FF-", "FM-", "FR-", "FSZ-", "GC-", "GMA-", "GMS-", "HB-", "ISM-", "JAA-", "JBS-", "JD-", "KG-", "KKP-", "KYT-", "LBG-", "LCH-", "LFM-", "LGG-", "M0-", "MBS-", "MC2-", "MCD-", "N41-", "NKS-", "NTR-", "PBD-", "PG-", "PPA-", "PQT-", "PRE-", "PT7-", "PT9-", "PTE-", "PTY-", "RSN-", "SBE-", "SCB-", "SCR-", "T32-", "T33-", "TA-", "TMA-", "TRX-", "TWN-", "UBR-", "UM2-", "UMP-", "WCA-", "XP-", "YBH-", "ZAV-", "JKM-", "JPD-", "JW-", "KA3-", "KA5-", "KAG-", "KB-", "KG4-", "KG5-", "KGP-", "KNS-", "LGW-", "LMN-", "LSG-", "LU2-", "MAE-", "MDG-", "MDN-", "MMP-", "MPM-", "MPV-", "MR-", "MRG-", "N22-", "N23-", "N25-", "N26-", "N28-", "N29-", "N35-", "N36-", "N37-", "N38-", "N39-", "NK2-", "NK3-", "NK8-", "NKD-", "PFA-", "PFU-", "PHM-", "PM-", "PMD-", "PPM-", "PRD-", "PT-", "PV2-", "PV3-", "PV4-", "PVC-", "PW6-", "PWP-", "PX-", "PXZ-", "PZ2-", "PZZ-", "RAV-", "RKY-", "RPC-", "RUF-", "RV2-", "RV3-", "SEG-", "SHM-", _
"SJM-", "SJR-", "SN2-", "SN3-", "SN4-", "SNP-", "SRC-", "T22-", "T23-", "T24-", "TKA-", "TRK-", "TSQ-", "TST-", "W3-", "W5-", "W6-", "WJM-", "WRX-", "X0-", "XM2-", "XM3-", "XM4-", "XPD-", "yd-", "ZAB-", "ZAC-", "ZAE-", "ZAN-", "ZAT-", "LU-", "WY-", "ZL-", "ABN-", "AT-", "ATH-", "AYH-", "BDD-", "BMD-", "BNB-", "BRN-", "BRY-", "BU-", "CCG-", "CFL-", "CKH-", "CXS-", "DJB-", "EAB-", "EJ-", "ETP-", "FNE-", "GB-", "GER-", "GGN-", "GHP-", "GI-", "GR2-", "GR5-", "GR6-", "GR7-", "GR8-", "GRY-", "HCR-", "HN3-", "HNT-", "JBM-", "JEM-", "JFM-", "JKR-", "JNP-", "JS2-", "JU4-", "JU5-", "JU6-", "JU7-", "JU8-", "JU9-", "JYD-", "KE-", "KE2-", "KT2-", "KT3-", "KTE-", "KY2-", "KYN-", _
"LFD-", "LLD-", "LNE-", "LX-", "ME2-", "ME3-", "MEC-", "MRN-", "MY2-", "MYM-", "NE-", "NFN-", "NMK-", "NT2-", "NT3-", "NTW-", "PD2-", "PD3-", "PD4-", "PD5-", "PDT-", "PH2-", "PHS-", "PMC-", "PP2-", "PPB-", "PSY-", "PTA-", "PW2-", "PW4-", "PWA-", "PWD-", "PWH-", "PY2-", "PY3-", "PY4-", "PYS-", "PYV-", "RDG-", "RGP-", "RKP-", "RKX-", "RPP-", "RUS-", "SC-", "SM2-", "SM5-", "SMS-", "SND-", "TEP-", "TKY-", "TUH-", "VPS-", "VST-", "VU2-", "VU3-", "VUE-", "WC-", "WC2-", "WPP-", "WRD-", "YU-")


ReDim rowsToHighlight(0) As String

Set allRange = ActiveSheet.UsedRange


For Each cell In allRange
For Each word In searchTerms
If InStr(1, cell, word, vbTextCompare) Then
rowsToHighlight(UBound(rowsToHighlight)) = CStr(cell.Row)
ReDim Preserve rowsToHighlight(UBound(rowsToHighlight) + 1)
End If
Next word
Next cell
On Error Resume Next
ReDim Preserve rowsToHighlight(UBound(rowsToHighlight) - 1)

Dim v As Long
For v = UBound(rowsToHighlight) To LBound(rowsToHighlight) Step -1
Rows(rowsToHighlight(v)).Interior.Color = vbGreen
Next

Application.ScreenUpdating = True

End Sub

3 个答案:

答案 0 :(得分:0)

这就是宏中所需要的(除了声明和searchTerms的定义之外,还要看条件格式

Set allRange = ActiveSheet.UsedRange

For Each cell In allRange
    For Each word In searchTerms
        If InStr(1, cell, word, vbTextCompare) Then cell.Interior.Color = vbGreen
    Next word
Next cell

Application.ScreenUpdating = True

End Sub

答案 1 :(得分:0)

将您的列表更改为以逗号分隔的字符串并将其拆分以供使用。删除了allRange,rowHighloght数组和其他不必要的东西。

确保在使用Exit For进行匹配时退出这样的长检查序列。您不需要激活工作表来引用它。我离开了.Activate,以防您希望代码在完成后将其发送给您,但它可以很容易地删除。

Sub Affiliates()
   'This code must be updated as affiliates are added or removed
  Dim searchTerms As Variant
  Dim cell As Range, word As Variant

  Application.ScreenUpdating = False
  Application.Calculation = xlManual
  searchTerms = "AF2-,AF3-,AF4-,AF5-,AF6-,AFP-,AIP-,AKB-,APE-,ASP-,AU-,AU2-,AU3-,au4-,AZ-,B1-,BD4-,BDZ-,BLS-,BLT-,BMK-,BMP-,BQ-,BR2-,BR3-,BRI-,BRT-,BTU-,BV-,BX2-,BXM-,BZG-,CAV-,CJW-,CM2-,CSI-,DES-,DGR-,DXE-,ED2-," & _
"ED3-,ED4-,ED5-,ED6-,EDA-,EMV-,ERR-,ERS-,FM2-,FMP-,FYI-,GCK-,GH-,GL2-,GL3-,GLP-,GPR-,GSH-,HDL-,HMF-,HO-,HW2-,HWM-,J33-,JC4-,JC5-,JCG-,JFG-,JG-,JGR-,JJM-,JPR-,JR4-,JRD-,JRW-,JSB-,JWW-,KAH-,KBP-,KC2-," & _
"KCP-,KM2-,KMF-,KN2-,KN3-,KNC-,KP2-,KPB-,KRN-,KRT-,LKV-,MB-,MJP-,MYG-,MZE-,P72-,PAC-,PTG-,PVT-,RGN-,S42-,S44-,S45-,S46-,S48-,S52-,S53-,SA1-,SA5-,SAN-,SD2-,SD3-,SD4-,SD5-,SD6-,SD7-,SD8-,SD9-,SHK-,SKY-,SMY-,SN-,SP-," & _
"SPA-,SQ2-,SQX-,SUD-,SUE-,SZT-,TEL-,TF2-,TGT-,THR-,TMT-,tpp-,VN-,WR-,WX-,WX3-,WYS-,YM2-,YM3-,YM4-,YM5-,YMT-,wdd-,AAA-,ABT-,CM3-,CM5-,CMG-,DCD-,DR9-,DRB-,DRW-,DVW-,EE-,EG2-,EG3-,EGS-,EMD-,EP2-,EP3-,EP5-,EPS-,EV-,FAS-,FL2-,GM8-,GM9-,GMN-,KR5-,KR6-,KR7-,KRC-,M33-,M34-,M35-,M36-,M37-,M38-,M39-,M42-," & _
"M43-,M46-,M47-,M48-,M49-,MM2-,MOX-,MR3-,MR4-,MRV-,MS5-,MS6-,MS7-,MS8-,MS9-,MSY-,MT-,MUS-,NM-,P32-,PF6-,PFP-,PM2-,PM3-,PM4-,PM5-,PM6-,PM7-,PM8-,PM9-,PMR-,RS2-,RSD-,RST-,S62-,S63-,SHE-,SMK-,SUN-,SVA-,Z1-,Z42-,ZA5-,ZA6-,ZAG-,ZAH-,ZDM-," & _
"3P-,AAP-,AD3-,AD4-,AD9-,ADC-,ADV-,AFF-,AJT-,ALB-,AMA-,AP2-,AP3-,APG-,APM-,APS-,ARG-,ASA-,AVD-,AZP-,BAG-,BCD-,BCK-,BE2-,BE3-,BGB-,BJB-,BP2-,BPM-,BR-,BTC-,BTM-,BUZ-,BWL-,C22-,C23-,C24-,CAR-,CCP-,CCW-,CG-,CGK-,CLJ-,CME-,CP9-,CPM-,CPR-,CPT-,CPU-,CRM-,CRN-,CT-,DAV-,DC-,DC3-,DC4-,DKP-,DNC-,DNF-,DNT-,DP2-,DPL-,DPT-,DQ-,DR2-,DRT-,E22-,EI-,EP-,FB2-,FB3-,FBG-,FCA-,FL-,FLN-,FNN-,FPS-,FVE-,GA-,GB2-,GEE-,GF2-,GFS-,GFY-,GM-,GME-,GN-,GU2-,GUS-," & _
"HJS-,JAE-,JDN-,JHG-,JNK-,JTP-,JWP-,JX2-,KCD-,KK2-,KKA-,KW-,L22-,L23-,l24-,L9-,LA5-,LAX-,LD-,LD2-,LR-,M44-,MA2-,MA5-,MA6-,MAJ-,MAL-,MD2-,MD3-,MDM-,MK1-,MKY-,MM-,MN-,MO-,MP5-,MPE-,MRK-,MTH-," & _
"MV-,MY-,NA-,NE2-,NE3-,NEP-,NF-,NGP-,NIP-,NNF-,NSM-,OCA-,OD-,P62-,P63-,PBB-,PCK-,PDM-,PEN-,PH-,PHX-,PLG-,PMM-,PMN-,PNR-,PPC-,PPW-,PSP-,PST-,PW3-,PW5-,QA-,QM-,RAD-,RAY-,RE-,RGK-,RG5-,RKT-,RSW-,RU-,RV-,S27-,SAM-,SC2-,SCG-,SCH-,SDC-,SF2-,SFL-,SGE-,SMA-,STW-,TBM-,TFG-,THK-,THY-,TOG-,TRC-,TW2-,TWE-,TY2-,TYB-,UC-,UH-,UP2-,UP3-,UPW-,VB-,WDB-,WM-,WTC-,WZ-,XS-,YN-,YN2-,YN3-,YN4-,YN5-,YN6-,YN7-,YNG-,YP-,YPR-,ZA2-,ZAA-,ZAD-,STT-,ef-,JX-," & _
"A2-,ABP-,ABS-,AE-,AF-,AJ-,ALL-,AM-,AN2-,ANS-,AP-,APP-,ASJ-,ASK-,ASM-,ATJ-,BA2-,BAA-,BAM-,BAS-,BBE-,BBP-,BG-,BG2-,BGD-,BK2-,BK3-,BK4-,BK5-,BK6-,BK7-,BLZ-,BMG-,BP-,BSK-,BTB-,BX-,BYJ-,CEC-,CHT-,CJ2-,CJR-,CMB-,CN-,COB-,CPC-,CPP-,CTA-,CWG-,D22-,D24-,D25-,D26-,D27-,D28-,D29-,D30-,D32-,D33-,D34-,D35-,DAJ-,DAK-,DAP-,DB2-,DBC-,DBP-,DCA-,DDP-,DEL-,DGJ-,DMJ-,DP3-,DPI-,DRA-,DS-,DS2-,DS3-,DS4-,DS5-,DS6-,DS7-,DS8-,DS9-,DSN-,DSP-,DSR-,DT2-,DT3-," & _
"DT4-,DT5-,DTM-,EC2-,ECL-,EDM-,ENS-,ERN-,ES2-,ES3-,es4-,ESC-,ESH-,EZB-,FDA-,FI-,FI2-,GBL-,GCR-,GRR-,GS-,GT2-,GTE-,HM2-,HM3-,HM4-,HM5-,HMG-,HN-,HNN-,IA-,JMS-,JSY-,K24-,K26-,K27-,KAU-,KMK-,KPN-,KRK-,LT-,MDY-,MKD-,MLM-,MMM-,MP-,MR2-,MR6-,MRA-,MRE-,NAA-,PA-,PCS-,PK2-,PK3-,PK4-,PK5-,PKG-,POD-,PT4-,PTS-,RDV-,RH2-,RHS-,RJS-,SA-,SBG-,SEB-,SJP-,SL2-,SLT-,SQ-,STC-,STF-,SY-,T99-,TRY-,UMT-,VP-,VZ-,VZ1-,WAG-,WDM-,WH-,YJ-,STM," & _
"A1-,AMS-,AN-,AY2-,AYW-,BB-,BDS-,BJC-,BNG-,BSH-,BW2-,BWR-,BWS-,CGP-,CM4-,CPS-,CQS-,CV-,CWN-,CY-,D42-,D43-,DPB-,DTG-,DTY-,DV-,DVD-,DVE-,DY2-,ELR-,ENX-,EST-,FN2-,FN3-,FN4-,FNT-,FNY-,FS2-,FSN-,GBD-,GG2-,GGM-,GLM-,GM5-,GSE-,HCE-,HGT-,HNA-,HYD-,IB-,IE-,IW-,J32-,JBE-,JEN-,JLR-,JLW-,JN6-,JN7-,JN8-,JNH-,JV2-,JVP-,KA2-,KBK-,KNX-,KPP-,KPR-,LC-,LPE-,LRE-,LV2-,LV3-,LV4-,LV5-,LVL-,M12-,M15-,M19-,M24-,M51-,M52-,M53-,M55-,M57-,M63-,M64-,M68-,M69-,M72-,M73-,M74-,M75-,MCC-,MCK-,MHA-,MJF-,MKE-,MMT-,MP2-," & _
"MPN-,MPT-,MR5-,MST-,MU6-,MUN-,NEB-,NVT-,NY5-,PJ2-,PJM-,PNY-,PRV-,PTM-,PTN-,RCG-,RED-,REN-,RH3-,RN2-,RND-,RT2-,RT3-,RT4-,RTC-,SDM-,SPP-,SV2-,SV3-,SV4-,SV5-,SV6-,SV7-,SVN-,SVS-,SXT-,TCB-,TE5-,TE6-,TEE-,TER-,TK2-,TKG-,TNY-,TUV-,VPG-,VU-,VW2-,VWP-,W25-,WO-,WR4-,WR5-,WR6-,WR8-,WR9-,WRH-,WTT-,Y23-,YG-,YK-,Z22-,Z23-,ZAM-,ZAQ-,ZAR-,ZAS-,ZAU-,ZFG-,ZIN-,ZR2-,BA-,BAR-,BES-,BLR-,BS2-,BSY-,CD-,CRT-,CS-,CT7-,CTY-,CVT-,CWP-,CZ-,DRS-,DVL-,EM2-,EM3-,EM4-,EM5-,EMF-,EPR-,EVE-,FP-,FSP-,FST-,HTT-,JA5-,JAC-,JAN-,JK2-,JKH-," & _
"BNT-,DER-,DWH-,EL-,EU-,FF-,FM-,FR-,FSZ-,GC-,GMA-,GMS-,HB-,ISM-,JAA-,JBS-,JD-,KG-,KKP-,KYT-,LBG-,LCH-,LFM-,LGG-,M0-,MBS-,MC2-,MCD-,N41-,NKS-,NTR-,PBD-,PG-,PPA-,PQT-,PRE-,PT7-,PT9-,PTE-,PTY-,RSN-,SBE-,SCB-,SCR-,T32-,T33-,TA-,TMA-,TRX-,TWN-,UBR-,UM2-,UMP-,WCA-,XP-,YBH-,ZAV-,JKM-,JPD-,JW-,KA3-,KA5-,KAG-,KB-,KG4-,KG5-,KGP-,KNS-,LGW-,LMN-,LSG-,LU2-,MAE-,MDG-,MDN-,MMP-,MPM-,MPV-,MR-,MRG-,N22-,N23-,N25-,N26-,N28-,N29-,N35-,N36-,N37-,N38-,N39-,NK2-,NK3-,NK8-,NKD-,PFA-,PFU-,PHM-,PM-,PMD-,PPM-,PRD-,PT-,PV2-,PV3-,PV4-,PVC-,PW6-,PWP-,PX-,PXZ-,PZ2-,PZZ-,RAV-,RKY-,RPC-,RUF-,RV2-,RV3-,SEG-,SHM-," & _
"SJM-,SJR-,SN2-,SN3-,SN4-,SNP-,SRC-,T22-,T23-,T24-,TKA-,TRK-,TSQ-,TST-,W3-,W5-,W6-,WJM-,WRX-,X0-,XM2-,XM3-,XM4-,XPD-,yd-,ZAB-,ZAC-,ZAE-,ZAN-,ZAT-,LU-,WY-,ZL-,ABN-,AT-,ATH-,AYH-,BDD-,BMD-,BNB-,BRN-,BRY-,BU-,CCG-,CFL-,CKH-,CXS-,DJB-,EAB-,EJ-,ETP-,FNE-,GB-,GER-,GGN-,GHP-,GI-,GR2-,GR5-,GR6-,GR7-,GR8-,GRY-,HCR-,HN3-,HNT-,JBM-,JEM-,JFM-,JKR-,JNP-,JS2-,JU4-,JU5-,JU6-,JU7-,JU8-,JU9-,JYD-,KE-,KE2-,KT2-,KT3-,KTE-,KY2-,KYN-," & _
"LFD-,LLD-,LNE-,LX-,ME2-,ME3-,MEC-,MRN-,MY2-,MYM-,NE-,NFN-,NMK-,NT2-,NT3-,NTW-,PD2-,PD3-,PD4-,PD5-,PDT-,PH2-,PHS-,PMC-,PP2-,PPB-,PSY-,PTA-,PW2-,PW4-,PWA-,PWD-,PWH-,PY2-,PY3-,PY4-,PYS-,PYV-,RDG-,RGP-,RKP-,RKX-,RPP-,RUS-,SC-,SM2-,SM5-,SMS-,SND-,TEP-,TKY-,TUH-,VPS-,VST-,VU2-,VU3-,VUE-,WC-,WC2-,WPP-,WRD-,YU-"
  searchTerms = Split(searchTerms, ",")

  For Each cell In Sheets("UPS").UsedRange
    For Each word In searchTerms
        If InStr(cell, word) > 0 Then
            cell.Interior.Color = vbGreen
            Exit For
        End If
    Next word
  Next cell

  Application.ScreenUpdating = True
  Sheets("UPS").Activate
End Sub

答案 2 :(得分:0)

您的程序似乎可以进一步改进,因为它实际上需要大量维护,如下所示:

  

我有大约1500个不同的“用户ID”号码(DWR)我没有回复   我正在使用的代码,但我添加了900左右的id到搜索数组   线

'This code must be updated as affiliates are added or removed

因此我建议在单独的工作表中创建一个表,然后该过程可以自动获取要搜索的项目数组。

此外,无需循环遍历工作表“UPS”中的每个单元格,并将内容与列表中的项目进行比较,而是使用FIND函数。

以下代码包含以上所有内容,并且还可以突出显示找到的字符串(用户ID)。

Sub Affiliates()
Rem Use a table to keep the list of affiliates instead of "Hard Codding" it (see Set Users ID List below)
Const kCol As Byte = 3 'Indicates the column containing the User Id's List
Dim WshSrc As Worksheet, WshTrg As Worksheet
Dim aUsrIdLst As Variant, vUsrId As Variant
Dim rFound As Range, sFound1st As String
Dim bPos As Byte

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Rem Set Worksheets
    Set WshSrc = ThisWorkbook.Worksheets("UserIds")
    Set WshTrg = ThisWorkbook.Worksheets("UPS")

    Rem Set Users ID List
    With WshSrc
        aUsrIdLst = .Cells(1, kCol).Resize(fLastRow_byCol(.Columns(kCol))).Value2
        aUsrIdLst = WorksheetFunction.Transpose(aUsrIdLst)
    End With

    Rem To Clear prior formatting - Uncomment if needed
    Rem watch out for prior formatting of all other cells!
    Rem WshTrg.UsedRange.Style = "Normal"

    With WshTrg.UsedRange
        For Each vUsrId In aUsrIdLst
            Set rFound = .Find( _
                What:=vUsrId, After:=.Cells(1), _
                LookIn:=xlValues, LookAt:=xlPart, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            If Not (rFound Is Nothing) Then
                sFound1st = rFound.Address
                Do
                    With rFound
                        bPos = InStr(rFound, vUsrId)
                        Rem Fill Interior and String Found
                        .Interior.Color = vbGreen
                        With .Characters(Start:=bPos, Length:=Len(vUsrId)).Font
                            .Bold = 1
                            .Color = RGB(55, 86, 35)
                    End With: End With
                    Set rFound = .FindNext(rFound)
                Loop While Not (rFound Is Nothing) And rFound.Address <> sFound1st

    End If: Next: End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic    'update as required

End Sub


Function fLastRow_byCol(ColTrg As Range) As Long
Rem ===============================================================================
    On Error Resume Next
    fLastRow_byCol = ColTrg.Find(What:="*", _
        After:=ColTrg.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
End Function