Excel VBA - matritsalarni ishlatish vositalaridan har bir xonaga xususiyatlarni o'rnatish mumkinmi?

Men yaqinda yaqinda ma'lum bo'lgan qatorlardan iborat har bir xonada qiymatlarni belgilash mumkinligini bilib oldim:

Worksheet.Range(Worksheet.Cells(Row1, Column1), Worksheet.Cells(Row2, Column2)) = MyMatrix

Bu erda MyMatrix o'lchamlari bilan 2D matritsa: Row2-Row1 va Column2-Column1.

Ko'rib turganimizdek, agar men har bir xonada (masalan, MyString ) boolean matritsa bo'lsa, har bir xonaga (masalan, .Font.Bold ) qo'llash uchun xuddi shunday qilsam, u ishlamaydi :

Worksheet.Range(Worksheet.Cells(Row1, Column1), Worksheet.Cells(Row2, Column2)).Font.Bold = MyMatrix

Yuqoridagi buyruqlar butun sonni "qalin-titroq" ni ikkinchi soniya uchun beradi va keyin hech narsa sodir bo'lmaydi. Qanaqasiga?

Men for siklining oldini olishni istardim, chunki mening kodim juda uzoq davom etadi.

UPDATE: "MyMatrix " oddiy " va " qalin " qatorlari bilan to'ldirgan bo'lsam ham xuddi shunday ishlamaydi va keyin yozing:

Worksheet.Range(Worksheet.Cells(Row1, Column1), Worksheet.Cells(Row2, Column2)).Font.FontStyle = MyMatrix

Men ham harakat qildim (va u ishlamayapti):

Worksheet.Range(Worksheet.Cells(Row1, Column1), Worksheet.Cells(Row2, Column2)).Cells.Font.FontStyle = MyMatrix
5
Siz gapirasiz Font.Bold = Sizning butun qatoringiz, qaysi indeksni belgilashingiz kerak Font.Bold = MyMatrix (1, 3)
qo'shib qo'ydi muallif Absinthe, manba
@Absinthe qanday qilib keyin keladi .Value = butun qator men istagan kabi ishlaydi?
qo'shib qo'ydi muallif Noldor130884, manba
Bundan tashqari, ha, Microsoft, butun bir qatorni qalin qilish mumkinligini aytadi: msdn.microsoft.com/de-de/library/office/ff823025.aspx ; Bu men xohlagan narsani emas.
qo'shib qo'ydi muallif Noldor130884, manba
"Font.Bold bir qatorni qaytarmaydi". OK, chuqurroq o'ylang va savolga javob bering. "Ikki buyruqlar, biri qiymatlarni belgilash va keyingi formatni belgilash uchun" ... Bu savolga nima qilish kerak? Menda qadriyatlarim buyruq (yuqorida ko'rsatilgan) bilan o'rnatilgandir va men har bir qiymatni "haqiqiy" yoki "noto'g'ri" bilan to'la boshqa matritsaga qarab qalin shriftga ega bo'lishini xohlayman. ". Va .value va .bold yordamida ishlatish ... men allaqachon qilaman va .bold ishlamaydi, bu ham savolga hech qanday aloqasi yo'q.
qo'shib qo'ydi muallif Noldor130884, manba
va .value va .bold bilan ham
qo'shib qo'ydi muallif Nathan_Sav, manba
Ikki buyruqlar, biri qiymatlarni belgilash va keyingi formatni belgilash uchun.
qo'shib qo'ydi muallif Scott Craner, manba
qo'shib qo'ydi muallif brettdj, manba
Font.Bold bir qatorni qaytara olmaydi va uni biriga o'rnatolmaysiz.
qo'shib qo'ydi muallif Rory, manba

7 javoblar

Boshqa javoblar aytilganidek, .Font xususiyati faqat matritsa emas, balki bir vaqtning o'zida bir nechta kengaytma oralig'ini o'rnatishi mumkin.

Bunga erishishning bir usuli True va matritsasidan ko'ra ma'lum bir shriftga ega bo'lishi kerak bo'lgan barcha hujayralar uchun hujayra havolalarini o'z ichiga olgan string > Noto'g'ri va hokazo. So'ngra, u oralig'i uchun shrift turini o'zgartiring. Masalan,

Dim strRange as String
strRange = "A1,B7,C3,D1"    ' set this in a loop or whatever
Worksheet.Range(strRange).Font.Bold = True
3
qo'shib qo'ydi
@AxelRichter aminmisan? Ko'proq ko'rinadigan ... stackoverflow.com/questions/10927764/vba-string-limit
qo'shib qo'ydi muallif Noldor130884, manba
X'D ga o'tish uchun 17 soat
qo'shib qo'ydi muallif Noldor130884, manba
Men, albatta, bu bilan ishlashim mumkin!
qo'shib qo'ydi muallif Noldor130884, manba
Xo'sh, mag'lubiyatga millionlab chiroy bor edi ... To'g'ri? Union Boshqa tomondan, maksimal 30 intervalgacha ega ... Lekin strRange dizgesini yaratish uchun aylana olishim kerak edi, shuning uchun men buni yineleyebilirim. ..
qo'shib qo'ydi muallif Noldor130884, manba
... bu ajoyib vaqtinchalik hal!
qo'shib qo'ydi muallif Noldor130884, manba
@ Noldor130884 Bir vaqtning o'zida 8000 xujayrali formatlashni o'zgartirish dramatik darajada tezlashishi kerak edi. Agar fikr ishlab chiqilsa, SteveES, ehtimol, loyiqdir (IMHO)
qo'shib qo'ydi muallif John Coleman, manba
@SteveES Men g'oyaning optimallashmagan versiyasini tushuntirdim va o'zim boshlaganimga nisbatan sezilarli yaxshilanishni ko'rdim. O'zgartirilgan javobni ko'ring.
qo'shib qo'ydi muallif John Coleman, manba
@ Noldor130884 Menimcha, VBA oralig'ida bo'lishi mumkin bo'lgan 8000 yaqin bo'lmagan hujayra chegarasi mavjud "Excel faqat VBA makrolari yordamida 8,192 nuqsonli bo'lmagan hujayralarni qo'llab-quvvatlaydi": qo'llab-quvvatlash. microsoft.com/en-us/help/832293/… . Ehtimol, bu faqat Excelning oldingi versiyalarida qo'llanilishi mumkin. Excel 2010 (?) Bilan cheklovlar ko'paygan.
qo'shib qo'ydi muallif John Coleman, manba
Ha, bu aqlli yondashuvdir (+1), lekin shunga o'xshash qatorlarda qancha hujayralar ishlatilishi mumkin?
qo'shib qo'ydi muallif John Coleman, manba
Bunday yondashuv faqatgina strRange uzunligi 256 dan past bo`lsa ishlaydi. Ushbu cheklovim javobimdagi test ishi yordamida osongina tekshirilishi mumkin.
qo'shib qo'ydi muallif Axel Richter, manba
Shuni tan olish kerakki, men bunday yondashuv aslida jarayonni tezlashtiryaptimi yoki yo'qligini tekshirish uchun tezkor sinovlar o'tkazmadim. Agar siz buni sinashga qaror qilsangiz, natijalarni bilishga qiziqaman.
qo'shib qo'ydi muallif SteveES, manba

Boshqalar ta'kidlaganidek, bu hech qanday to'g'ridan-to'g'ri yo'l emas.

Agar bunday narsalarni juda ko'p qilsangiz, uni quyidagi substansiyaga tushirishi mumkin:

  • Ekranni yangilashni va avtomatik hisoblashni o'chiradi
  • ni hisoblab chiqadi
  • Bolalning standart sozlamasi - Boolean matritsasida aksariyat
  • Barcha qatorni asl qiymati
  • ga sozlaydi
  • Hujayralarning yarmidan ko'pini o'zgartiradigan hujayralar bo'ylab harakatlanuvchi
  • Displeyni yangilash va hisoblash rejimini pastki
  • deb nomlangan paytda nima bo'lganiga qayta tiklaydi

Sub BoldFace(MyRange As Range, MyMatrix As Variant)
    'The dimensions of MyRange and MyMatrix are assumed the same
    'no error checking

    Dim i As Long, j As Long, m As Long, n As Long
    Dim su As Boolean, ac As Long
    Dim default As Boolean
    Dim TrueCount As Long

    su = Application.ScreenUpdating
    Application.ScreenUpdating = False
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual

    m = MyRange.Rows.Count
    n = MyRange.Columns.Count
    For i = 1 To m
        For j = 1 To n
            If MyMatrix(i, j) Then TrueCount = TrueCount + 1
        Next j
    Next i

    default = TrueCount > m * n/2 'defaults to true if over half the matrix is true
    MyRange.Font.Bold = default

    With MyRange
        For i = 1 To m
            For j = 1 To n
                If MyMatrix(i, j) = Not default Then .Cells(i, j).Font.Bold = MyMatrix(i, j)
            Next j
        Next i
    End With

    Application.ScreenUpdating = su
    Application.Calculation = ac
End Sub

Quyidagi kabi sinov qilingan:

Sub test()
    Dim i As Long, j As Long
    Dim R As Range, m As Variant
    Dim start As Double, elapsed As Double

    Randomize

    ReDim m(1 To 10000, 1 To 100)
    For i = 1 To 10000
        For j = 1 To 100
            m(i, j) = Rnd() < 0.9
        Next j
    Next i

    Set R = Range(Cells(1, 1), Cells(10000, 100)) '1 million cells!
    start = Timer
    BoldFace R, m
    elapsed = Timer - start
    Debug.Print elapsed

End Sub

When I run it this way, where 500,000 cells (on average) need to be changes, it takes about 15.3 seconds on my machine. If I change the line m(i, j) = Rnd() < 0.5 to m(i, j) = Rnd() < 0.1 (so only 10% of the cells will need to be changed) it takes about 3.3 seconds.

On Edit I was curious to see how the idea of @SteveES would pan out. The following is a non-aggressive approach that does it row by row, and is meant more as proof of concept. A more aggressive approach would wait until Union throws an error and then discharge then:

Sub BoldFace(MyRange As Range, MyMatrix As Variant)
    'The dimensions of MyRange and MyMatrix are assumed the same
    'no error checking

    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim lim As Long, needsFixed As String, toFix As Range
    Dim su As Boolean, ac As Long
    Dim default As Boolean
    Dim TrueCount As Long

    su = Application.ScreenUpdating
    Application.ScreenUpdating = False
    ac = Application.Calculation
    Application.Calculation = xlCalculationManual

    m = MyRange.Rows.Count
    n = MyRange.Columns.Count

    For i = 1 To m
        For j = 1 To n
            If MyMatrix(i, j) Then TrueCount = TrueCount + 1
        Next j
    Next i

    default = TrueCount > m * n/2 'defaults to true if over half the matrix is true
    MyRange.Font.Bold = default

    With MyRange
        For i = 1 To m
            k = 0
            Set toFix = Nothing
            For j = 1 To n
                If MyMatrix(i, j) = Not default Then
                    k = k + 1
                    If toFix Is Nothing Then
                        Set toFix = .Cells(i, j)
                    Else
                        Set toFix = Union(toFix, .Cells(i, j))
                    End If
                End If
            Next j
            toFix.Font.Bold = Not default  
        Next i
    End With

    Application.ScreenUpdating = su
    Application.Calculation = ac
End Sub

Har qanday holatda, men ushbu kodni yuqoridagi kabi bir xil test subasi bilan ishlatganimda, mashinamda taxminan 7 soniya (15 dan ortiq) davom etadi. Agar shriftni o'rnatmasdan oldin jamg'arma 50-100 hujayralarni to'plab, 50% bo'lsa, unda hatto agressiv yondashuvlar uchun ham yaxshi bo'ladi.

2
qo'shib qo'ydi
Hujayralar soni haqiqatan ham tasodifiy va ular 10% yoki 60% yoki nima bo'lishini oldindan taxmin qila olmayman. Siz allaqachon taklif qilgan birinchi qadamlarni qilaman, ammo siz hamkasblarimning har qanday narsani tezlashtirish uchun menga qanday bosim berganidan hayratda qolasiz. Kodni koddan ko'ra kattaroq bo'lishi mumkin emasligini ta'kidlaganingiz uchun tashakkur ...
qo'shib qo'ydi muallif Noldor130884, manba
@ Noldor130884 Odatiy yondashuv, taxminan 30 soniyadan 15 soniyagacha soddalashtirilgan (aynan men boshlaganim) looplardan farqli o'laroq, oldindan hisoblash eng yomon holatda kamida 50% tezlikni berish kerak, . Kichkina intervallarni uchun matritsani ikki marta aylantirish, ehtimol, bunga loyiq emas.
qo'shib qo'ydi muallif John Coleman, manba

Matritsangizni FormatCondition formatida qo'llashingiz mumkin.

Matnning diapozonidagi Sheet2! A1: B10 dan farqli hujayra bo'lsa, bu namuna Sheet1! A1: B10 qatoridagi har bir xonani formatlaydi: True :

' update the matrix
Range("Sheet2!A1:B10").Value2 = MyMatrix

' add a format condition
With Range("Sheet1!A1:B10").FormatConditions.Add(xlExpression, , "=Sheet2!A1:B10=True")
    .Font.Bold = True
    .Interior.Color = 255
End With
2
qo'shib qo'ydi
Agar bu juda yaxshi echim (+1) bo'lsa ham, men undan qochmoqchiman ... Men bundan keyin hamkasblarimni bezovta qilishi mumkin bo'lgan shartli formatlashni yaratishga qo'rqaman ...
qo'shib qo'ydi muallif Noldor130884, manba

Range.Value Property (Excel) hujjatiga binoan bu "ko'rsatilgan qiymatning qiymatini ifodalovchi Variant qiymatini qaytaradi yoki o'rnatadi». Ushbu Variant qiymati bitta qiymat yoki qiymatlar qatyokii bo'lishi mumkin. Shunday qilib

 With ActiveSheet

  .Range("A1:B3").Value = [{1,2;3,4;5,6}]  

  aValues = .Range("A1:B3").Value

 End With

ishlaydi.

Lekin Range.Font Xususiyati (Excel) "Bir < code> Shrift ob'ektini ko'rsatish uchun ishlatiladi. ". bir harflarning ob'ektini va harflarning moslamalarini degan ma'noni anglatadi. Shunday qilib

...
  aFonts = .Range("A1:B3").Font
...

ishlamaydi. Bundan tashqari

...
  .Range("A1:B3").Font = aFonts
...

ishlaydi.


Buni qilish mumkin edi

...
  Set oFont = .Range("A1:B3").Font
...

ammo oFont butun majmuani uchun bir harflarning obyekti ham bo'ladi.

Shunday qilib

...
  oFont.FontStyle = "bold italic"
...

yoki

...
  oFont.Bold = True
...

har doim ham butun intervalgacha ta'sir qiladi.


echimlar:

The best idea would really be the one of @SteveES. It is using a range which is a union of all cells which shall be bold. But this approach will only wyokik if the length of strRange is lower than 256. This limit can easily be tested using the following:

Dim strRange As String
Fyoki r = 1 To 125 Step 2
 strRange = strRange & "A" & r & ","
Next
strRange = Left(strRange, Len(strRange) - 1)
MsgBox Len(strRange)
With ActiveSheet
 .Range(strRange).Font.Bold = True
End With

This will fail at .Range(strRange).Font.Bold = True because Len(strRange) is 259 . If the loop of r is from 1 to 124 only, then it will wyokik having Len(strRange) = 254.

Shunday qilibif the requirement is having a random number of cells which shall be fyokimatted bold and cannot be determinated using conditional fyokimatting, the most perfyokimant solution fyoki me is really a loop over all cells having Application.ScreenUpdating = False while looping and setting bold.

Sub setRangeValuesWithStyles()

 lRows = 100
 lCells = 100

 ReDim aValues(1 To lRows, 1 To lCells) As Variant
 ReDim aFontBolds(1 To lRows, 1 To lCells) As Boolean

 Fyoki r = 1 To lRows
  Fyoki c = 1 To lCells
   Randomize
   iRnd = Int((100 * Rnd()) + 1)
   aValues(r, c) = IIf(iRnd < 50, "T" & iRnd, iRnd)
   Randomize
   iRnd = Int((100 * Rnd()) + 1)
   aFontBolds(r, c) = IIf(iRnd < 50, True, False)
  Next
 Next

 lStartRow = 5
 lStartCol = 5

 With ActiveSheet
  Set yokiange = .Range(.Cells(lStartRow, lStartCol), .Cells(lStartRow + lRows - 1, lStartCol + lCells - 1))
  yokiange.Value = aValues
  Application.ScreenUpdating = False
  Fyoki r = 1 To lRows
   Fyoki c = 1 To lCells
    yokiange.Cells(r, c).Font.Bold = aFontBolds(r, c)
   Next
  Next
  Application.ScreenUpdating = True
 End With

End Sub

Even using Union fyoki partially ranges (cells in each rows fyoki example) the perfyokimance is not better but myokie wyokise in my tests.

2
qo'shib qo'ydi
Agar buni qilish imkonim bo'lsa, shartli formatlashni ishlatardim, lekin dasturda ma'lum bir xonaga qo'yish uchun raqamni qalin shaklda yoki formatlash kerak bo'lsa, oxir-oqibat belgilangan shart-sharoitlar mavjud. uning miqdori haqida emas, balki qanday qilib hisoblangani haqida. "Nima qilishim kerak" degan savolni men aynan shunday deb so'radim: men dasturni tezlashtirishim kerak va menda "ko'chadan o'tib ketishdan qochishim mumkinmi" degan savolni berishni istardim.
qo'shib qo'ydi muallif Noldor130884, manba
Bir satr> 256 ta harf bo'lishi mumkin emasmi? stackoverflow.com/questions/10927764/vba-string-limit
qo'shib qo'ydi muallif Noldor130884, manba
Javob berishga o'xshash deb belgilashdan oldin for döngülerini ishlatmasdan shrift xususiyatlarini belgilash mumkinmi? Hech kim bu o'ziga xos muammoni oldin hal qilmaganmi? Bu xususiyatlarni belgilash yoshlarni talab qiladi ...
qo'shib qo'ydi muallif Noldor130884, manba
Bu String cheklovi emas, lekin KOffice (addressString) manzil satrlari uchun cheklash kabi ko'rinadi. Hujjatlanmagan ko'rinadi, ammo mening misolimdan foydalanish oson.
qo'shib qo'ydi muallif Axel Richter, manba
" For ko'chadan foydalanishni hojat qoldirmasdan shrift xususiyatlarini belgilang" To'liq amalga oshirish uchun nima qilish kerak? Ehtimol shartli formatlash yaxshi yondashuv bo'larmidi?
qo'shib qo'ydi muallif Axel Richter, manba

Ushbu funktsiyani sinab ko'ring:

Rng_fBooleanProperties_ByArray(exRngProp, rTrg, aProperty)

Quyidagi Boolean KOffice Properties ni belgilaydigan foydalanuvchi belgilangan funktsiya: AddIndent, Font.Bold, Font.Italic, Font.Strikethrough, Font.Subscript, Font.Superscript, FYoKImulaHidden, Locked, ShrinkToFit, UseStandardHeight, UseStandardWidth va WrapText. Muvaffaqiyatli bo'lsa True funksiyasini qaytaradi.

Sintaksis

exRngPropAs E_RngProp: Customized Enumeration to define the range property to be updated.

rTrgs Range: Target range to updated.

aPropertyAs Variant: Array of booleans with cells to be updated.

U foydalanadi:

maqsad YoKIalig'i haqiqiy tarkibi (ya'ni raqamlar, matn, mantiqiy, xato, fYoKImulalar) ni ushlab turadigan Array .

• Yangilanadigan xususiyatni aniqlash va aniqlash uchun E_RngProp Enumeration .

Range.Value xususiyatini Boolean qatYoKIiga kiritish uchun maqsad YoKIalig'i .

False qiymatini bo'sh hujayralarga o'zgartirish uchun Range.Replace usuli.

Range.SpecialCell usuli Range.Property uchun har bir Cell.Value yYoKIdamida kerakli tarzda o'rnatish uchun.

Bu kod:

Option Explicit

Enum E_RngProp
    Rem Range Properties - Boolean & Read\Write
    exAddIndent = 1
    exFontBold
    exFontItalic
    exFontStrikethrough
    exFontSubscript
    exFontSuperscript
    exFYoKImulaHidden
    exLocked
    exShrinkToFit
    exUseStandardHeight
    exUseStandardWidth
    exWrapText
    End Enum

Function Rng_fBooleanProperties_ByArray(exRngProp As E_RngProp, rTrg As Range, aProperty As Variant) As Boolean
Dim rPropOn As Range
Dim aFml As Variant

    Rem Validate Input
    If rTrg Is Nothing Then Exit Function
    If Not IsArray(aProperty) Then Exit Function
    If rTrg.Rows.Count <> UBound(aProperty) Then Exit Function
    If rTrg.Columns.Count <> UBound(aProperty, 2) Then Exit Function

    With rTrg

        Rem Get FYoKImulas from Target Range
        aFml = .FYoKImula

        Rem Apply Bold Array to Target Range
        .Value = aProperty
        .Replace What:=False, Replacement:="", _
            LookAt:=xlWhole, SearchYoKIder:=xlByRows, _
            MatchCase:=False, SearchFYoKImat:=False, ReplaceFYoKImat:=False
        On ErrYoKI Resume Next
        Set rPropOn = .SpecialCells(xlCellTypeConstants, 23)
        On ErrYoKI GoTo 0

        Select Case exRngProp
        Case exAddIndent
            .AddIndent = False
            If Not rPropOn Is Nothing Then rPropOn.AddIndent = True

        Case exFontBold
            .Font.Bold = False
            If Not rPropOn Is Nothing Then rPropOn.Font.Bold = True

        Case exFontItalic
            .Font.Italic = False
            If Not rPropOn Is Nothing Then rPropOn.Font.Italic = True

        Case exFontStrikethrough
            .Font.Strikethrough = False
            If Not rPropOn Is Nothing Then rPropOn.Font.Strikethrough = True

        Case exFontSubscript
            .Font.Subscript = False
            If Not rPropOn Is Nothing Then rPropOn.Font.Subscript = True

        Case exFontSuperscript
            .Font.Superscript = False
            If Not rPropOn Is Nothing Then rPropOn.Font.Superscript = True

        Case exFYoKImulaHidden
            .FYoKImulaHidden = False
            If Not rPropOn Is Nothing Then rPropOn.FYoKImulaHidden = True

        Case exLocked
            .Locked = False
            If Not rPropOn Is Nothing Then rPropOn.Locked = True

        Case exShrinkToFit
            .Locked = False
            If Not rPropOn Is Nothing Then rPropOn.ShrinkToFit = True

        Case exUseStandardHeight
            .UseStandardHeight = False
            If Not rPropOn Is Nothing Then rPropOn.UseStandardHeight = True

        Case exUseStandardWidth
            .UseStandardWidth = False
            If Not rPropOn Is Nothing Then rPropOn.UseStandardWidth = True

        Case exWrapText
            .WrapText = False
            If Not rPropOn Is Nothing Then rPropOn.WrapText = True

        End Select

        Rem Reset FYoKImulas in Target Range
        .FYoKImula = aFml

    End With

    Rem Set Results
    Rng_fBooleanProperties_ByArray = True

End Function

Bundan tashqari, ushbu chiziqlar sizning asosiy amaliyotingizning boshida bo'lishi jarayoni tezlashtirishga yYoKIdam beradi:

With Application
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Va ushbu bosqichlar sizning asosiy amaliyotingizning oxirida:

With Application
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With

Funksiyani ushbu usullarning har qanday usullaridan foydalanib chaqirish mumkin:

If Not (Rng_fBooleanProperties_ByArray(exFontBold, rTrg, aBold)) Then GoTo ErrYoKI_Message

YoKI

Call Rng_fBooleanProperties_ByArray(exFontItalic, rTrg, aItalic)

YoKI

Rng_fBooleanProperties_ByArray exFontStrikethrough, rTrg, aStrikethrough

Foydalanilgan resurslarni chuqurroq tushunish uchun quyidagi sahifalarni o'qishni tavsiya eting:

Enum Statement, Function Statement, On ErrYoKI Statement,

Range Object (Excel), Range.Replace Method (Excel), Range.SpecialCells Method (Excel),

Select Case Statement, Using Arrays, With Statement.

1
qo'shib qo'ydi
Ha, buning uchun uzr so'rayman, sizning kodingizni noto'g'ri tushunib oldim ... siz haqsiz. Bu @Michael tomonidan berilgan javobdan biroz ko'proq. Men uning javobidan keyin faqatgina sharhga yozganimdek, men buni sinab ko'rdim va oxir oqibatda yechim etarlicha tezlashdi. "256 ta belgilar" kamchiliklari bo'lsa ham, men eng yaxshi fazilatni o'zimga berdim. Va nihoyat, mening kodimga bo'linib, ko'milgan Maykl kodining soddalashtirilgan versiyasini ishlatib bo'ldim.
qo'shib qo'ydi muallif Noldor130884, manba
Xo'sh, siz bu funksiyani sinab ko'rmadingiz. Agar shunday bo'lmasa, siz uchun kerak emasligini bilib olasiz ... Keyin bu funksiya hujayralar orqali, hozirgina bajarayotgan boolean qatorni yaratadi va funktsiyaga yuboradi, funktsiya uni ishlatmasdan g'amxo'rlik qiladi Uchun ... Keyingi. U butun bir qatorda ishlaydi. Uni sinab ko'ring, keyin sharhlaringizni qaytaring.
qo'shib qo'ydi muallif EEM, manba

Vaqtinchalik kukla ishchi varag'idan foydalaning va biron bir pastadir yoki doimiy ma'lumotlar o'zgarishlarini talab qilmaydigan, bir vaqtning o'zida bir nechta shriftlarni qo'llashi mumkin, qo'shimcha formatlash o'zgarishlarini qo'sha oladigan va hajmi kattaligiga (cheklovlar faqat cheklangan nomlangan intervaldagi hujayralar va almashtirishning ishlashi mumkin).

Matnni boolean qadriyatlarni yangi dastlabki ishchi varagacha (yoki bir nechta formatlarni bir vaqtning o'zida bajarish uchun matn identifikatorlari) yaratishga/saqlashga boshlang.

FontMatrix

So'ng matrisinizdeki har bir shrift uslubi uchun Replace usulini bir marta foydalaning, matnni bir xil matnga almashtiring, lekin formatni mos uslub bilan almashtiring. Keyinchalik haqiqiy ma'lumotlarga qo'llashni xohlagan formatlash bilan bir qatorga egasiz:

Fonts

Keyin faqat format oralig'ini nusxa ko'chiring va PasteSpecial dasturidan faqat sizning ma'lumotlaringiz oralig'iga formatlarni joylashtirish uchun foydalanasiz. Nihoyat, agar u foydali bo'lmasa, kupe varag'i/intervalni o'chirib tashlashingiz mumkin.

Bu VBA-da juda sodda tarzda amalga oshirilishi mumkin. Formatlangan ma'lumot "Ma'lumot" da ko'rsatilgan va formatlarning matritsasi nomlangan "Fonts" da (hali ham tekis matn sifatida va yuqoridagi birinchi rasmda ko'rsatilgan qadriyatlardan foydalangan holda) yaratilgan bo'lsa, , MyMatrix ni yangi sahifaga saqlash va intervalni nomlash orqali amalga oshirilishi mumkin).

Sub CopyFonts()

    With Range("Fonts")
        Application.ReplaceFormat.Font.FontStyle = "Bold"
        .Replace What:="bold", Replacement:="bold", SearchFormat:=False, ReplaceFormat:=True
        Application.ReplaceFormat.Font.FontStyle = "Italic"
        .Replace What:="italics", Replacement:="italics", SearchFormat:=False, ReplaceFormat:=True
        .Copy
    End With

    Range("Data").PasteSpecial Paste:=xlPasteFormats

    Application.CutCopyMode = False

End Sub

Men taqqoslash uchun bir necha ishlash sinovlarini ham qildim. Yuqoridagi modelni 1 mln. Hujayradan A1: J100000 dan takrorladim. Shriftlar oralig'ida tekis matndan boshlab, ularning o'rniga ikkita dasturni qo'llash va formatlashni ma'lumotlar oralig'iga joylashtirish uchun jami 16 soniya kerak bo'ldi (Screenwatching bilan FALSE o'rnatilgan).

Qalinligingiz kerak bo'lgan yagona FontStyle bo'lsa va sizning matritsangiz faqat ROST va FALSE qiymatlariga ega bo'lsa, shunchaki qalin formatlash qo'llaniladigan kodning "qalin" o'rniga "ROST" qiymatini qidirishga harakat qiling. Shu bilan bir qatorda, qo'shimcha yoki murakkab formatlarni almashtirish formatlarida osongina aniqlash mumkin.

1
qo'shib qo'ydi
Buni amalga oshirish uchun ishchi varaqani yaratish (agar u yaxshi o'tmish bo'lsa ham) ko'p vaqt va xotirani anglatadi, hech bo'lmaganda men kompyuterimda ko'rgan narsam
qo'shib qo'ydi muallif Noldor130884, manba
Men asosan bir nechta varaqlarni topib, undagi ma'lumotlar juda ko'p. Keling, bitta bitta ish varag'ini qo'shib qo'ydim va u erda format saqlangan deb o'ylayman. Bu degani: har qanday formatni o'chirib tashlash, haqiqiy yoki noto'g'ri qiymatlarni nusxalash, formatlash, nusxalash formati, joylashtirish formatini boshqa sahifaga almashtirish ... Bu ishlash uchun biroz "og'ir"
qo'shib qo'ydi muallif Noldor130884, manba
Kodimni sinab ko'rish uchun bir necha daqiqa bor edi, garchi ilova uchun mening ehtiyojlarimga o'xshash bo'lib qolsa va kodimning turli qismlarini kiritish kerak edi. Bunday holda siz haqsiz. Yaxshi ishlaydi. Turli xil ishchi varaqlarda 10.000 hujayra bo'linadigan bir narsaga bir necha soniyalar tushadi.
qo'shib qo'ydi muallif Noldor130884, manba
Agar siz allaqachon kodingizda bir qator o'zgaruvchida yaratilgan Boolean qiymatlari matritsasiga ega bo'lsangiz (bu siz allaqachon bajarayotgan kabi ko'rinadi), so'ngra ushbu qiymatlarni yangi bo'sh ish sahifasiga saqlang (kodning birinchi parchasi bilan bir xil tarzda). sizning savolingiz) ko'p vaqtni qo'shmasligi kerak. Men VBAdagi 1 mln. Qiymatdagi Boolean massasini yaratganim uchun test qildim (oldingi sinovim bo'yicha 100000 dan 10 gacha); va bu oddiy qiymatlarni bo'sh ish sahifasiga saqlash uchun faqat 6 soniya kerak bo'ldi. Shuni esda tutingki, siz formatlarni qo'llayotib, siz formatlangan Boolean qiymatlarining vaqtinchalik ish sahifasini o'chirib tashlashingiz mumkin.
qo'shib qo'ydi muallif Michael, manba
Men biroz hayratga tushdim, lekin agar siz qayta ishlash paytida xotira uchun kurashayotgan bo'lsangiz, qadriyatlarni ishchi varaqqa saqlaganingizdan keyin darhol uning xotirasini bo'shatish uchun 1 dan 1 gacha bo'lgan ketma-ket o'zgaruvchini qayta ishlashga harakat qilib ko'rishingiz mumkin. (Men bunga qanday ta'sir qilishini aniq bilmayman, agar mavjud bo'lsa). Ushbu yondashuv bilan aslida uzoq vaqt davomida nima qilayotganingizni aniqlab bera olasizmi?
qo'shib qo'ydi muallif Michael, manba
Mening testimdan shuni ko'rsatdiki, bir million hujayra uchun bitta dastur hozirgi kunga qadar boshqa eng yaxshi yechimga o'xshash ko'rsatkichga ega edi. Har bir varaqa va intervalgacha ("formatlar") har qanday echim takrorlash kerak bo'ladi. Formatlashni nusxalash va joylashtirishda ishlash ustunligi bor, lekin u sizning kodingizda hech qanday looplashni talab qilmasligi bilan bog'liq, bu sizning oldini olishga harakat qilyapsiz, ammo boshqa barcha echimlarda talab etiladi. Siz haqiqatdan ham ushbu echimni sizning ma'lumotlaringiz bo'yicha sinab ko'rdingizmi?
qo'shib qo'ydi muallif Michael, manba

Bu mumkin emas. Biroq, siz bir marhamatni belgilab qo'ygansiz va ba'zi bir masalalarni sarfladingiz, shuning uchun men ba'zi tegishli maslahatlar bera olaman. Shunday qilib, siz kodni saqlash uchun VBA uslublari ichiga formatlashingiz mumkin. .

Shunday qilib, siz bir marotaba stil yaratasiz va keyinchalik u bir qatorni o'rnatish uchun bitta plyus. Bu vaqtni tejash kerak. Ba'zi bir misol kodi.

Option Explicit

Sub TestSetUpStyle()

    Dim stylFoo As Excel.Style
    On Error Resume Next
    Set stylFoo = ThisWorkbook.Styles.Item("foo")
    stylFoo.Delete
    Set stylFoo = Nothing
    On Error GoTo 0

    If stylFoo Is Nothing Then
        'https://msdn.microsoft.com/en-us/library/office/ff821826.aspx
        Set stylFoo = ThisWorkbook.Styles.Add("foo")

        '* I CAN SET ALL SORTS OF STYLE PROPERTIES ONCE HERE ...
        stylFoo.Font.Name = "Arial"
        stylFoo.Font.Size = 18

        stylFoo.Interior.ColorIndex = 3
        With stylFoo.Borders
            .LineStyle = xlContinuous
            .Color = vbRed
            .Weight = xlThin
        End With

        stylFoo.NumberFormat = "$000.00"

    End If

    Sheet1.UsedRange.Style = "foo" '* THEN IN ONE LINE WE SET ALL THOSE PROPERTIES

End Sub

Bundan tashqari, sahifani yozish/formatlash davomiyligi uchun Application.ScreenUpdating = FALSE tezligini o'rnatish uchun. Buni boshqarish uchun RAII naqshde.

0
qo'shib qo'ydi
Bu o'rganish uchun juda yaxshi narsa, lekin afsuski, u mening muammomni hal qilmaydi. Men qilishim kerak bo'lgan yagona narsa shriftlarni qalin qilib belgilash va bu boolean matritsadan jasur yoki odatiy tarzda hujayralarning butun bir qatorini yaratish masalasiga murojaat qilmaydi
qo'shib qo'ydi muallif Noldor130884, manba