このExcel VBAコードを変更する手助けをしてくれる人はいますか？

Question

私は編集しようとしているExcelスプレッドシートを持っています。これは、データを処理するために使用される特定の列のフィールドを消去するクリーナーです。このコードは以前の同僚によって書かれたものです。ファイルはここにあります。私はExcelに比較的新しいだと私はコードを見ているとき、私はそれをすべての多くを理解していなかったので、VBAについて多くを知らない

http://www.mediafire.com/file/luv3wsfhdvz20h7/Master_data_scrubber_-_USE_THIS_ONE.xlsm

Anways。私はクリーニングマクロを編集しようとしています。クリーンな全ボタンがあり、それは列A-APを取り、それの隣に新しい値の列を作成します。各列には個別のボタンクリーナーもあります。

列Bにはsku番号の列（I.G 40118）が含まれており、クリーンボタンにメーカーコードが追加されます（i.g. happ）。したがって、Cleanを押すと、BとCの間に列が挿入されます。この新しい列には値happ40118が入ります。

列Kにはイメージ名が付けられます。 K2の値は "hungryhippos-box.jpg"となります。現在、K列のクリーンボタンは、セルに挿入した値を新しい挿入列からコピーします。

ボタンを実際に値をコピーする代わりに、Cleaned_Sku列（新しく作成された列C）のセルから値を取り出し、列K（.jpg）の値から拡張子をタックして連結しますそれらを一緒に新しく作成された列Lに入れます。値はhapp40118.jpgのようになります。

コードは以下のようになります。

**For the Clean All** 

Private Sub Clean_ALL_Click() 

MsgBox ("This action will take a few moments.") 
Application.ScreenUpdating = False 
Cells.Select 
    Range("AM9").Activate 
    With Selection.Font 
     .Name = "Arial" 
     .Size = 8 
    End With 

Call CleanSKUs_Click 
Call CleanBrand_Click 
Call Clean_MFG_SKU_Click 
Call Clean_UPC_Click 
Call Clean_ISBN_Click 
Call Clean_EAN_Click 
Call Clean_product_name_Click 
Call Clean_Short_desc_Click 
Call Celan_long_desc_Click 
Call Clean_Image_Click 
Call Clean_MSRP_Click 
Call Clean_Cost_Click 
Call Clean_product_weight_Click 
Call Clean_product_weight_u_Click 
Call Clean_product_length_Click 
Call Clean_product_width_Click 
Call Clean_product_height_Click 
Call Clean_product_lwh_uom_Click 
Call Clean_age_range_Click 
Call Clean_Origin_Click 
Call Clean_origin_text_Click 
Call Clean_Product_safety_Click 
Call Clean_category_Click 
Call Clean_Processed_date_Click 
Call Clean_Interactive_URL_Click 
Call Cleaned_Drop_ship_Click 
Call Cleaned_Developmental_Attributes_Click 
Call Clean_keywords_Click 
Call Clean_product_available_date_Click 
Call Clean_gender_Click 
Call Clean_attribute_Click 
Call Clean_products_Awards_Click 
Call Clean_P_Awards_index_Click 
Call Clean_Out_of_Production_Click 
Application.ScreenUpdating = True 
MsgBox ("The data cleaning is done!" & vbCrLf & vbCrLf & " All the data has been copied to a new column," & vbCrLf & "check the data before using it.") 

End Sub 

---------- 
**For the Clean SKU** 

Private Sub CleanSKUs_Click() 

Dim a$, b$, C$, prefix$, count$, MyLetter$, number, ii, j, I As Integer 
Dim lr As Long 
Dim r As Range 
Dim popbox As String 
Dim popcount, loopI As Integer 

For intCounter = 1 To ActiveSheet.UsedRange.Columns.count 
    count$ = Cells(1, intCounter).Address(False, False) 
    Range(count$).Select 
    If ActiveCell.Value = "SKU" Then 
     number = intCounter 
     ActiveCell.Offset(0, 1).EntireColumn.Insert 
     ActiveCell.Offset(0, 1).Value = "Cleaned SKUs" 
    Exit For 
    End If 
Next intCounter 

ii = number/26 
If ii > 1 Then 
    ii = Int(ii) 
    j = ii * 26 
    If number = j Then 
    number = 26 
    ii = ii - 1 
    Else 
    number = number - j 
    End If 
    MyLetter = ChrW(ii + 64) 
End If 

MyLetter$ = MyLetter$ & ChrW(number + 64) 
lr = Cells(Rows.count, "B").End(xlUp).Row 'find Last row 

Set r = Range(MyLetter$ & "2:" & MyLetter$ & lr) 'define working range 

Sheets("VARs").Activate 
ActiveSheet.Cells(3, 2).Select 
prefix$ = Selection.Value 
Sheets("NewData").Activate 

Dim d 
Set d = CreateObject("Scripting.Dictionary") 
popcount = 0 
loopI = 1 

For Each cell In r 

loopI = loopI + 1 
If d.Exists(cell.Value) Then 
    ' tag the d(cell.value) row -- i.e. (the first appearance of this SKU) 
    Rows(d(cell.Value) & ":" & d(cell.Value)).Select 
    Selection.Interior.ColorIndex = 6 
    ' tag the row 
    Rows(loopI & ":" & loopI).Select 
    Selection.Interior.ColorIndex = 6 
    ' add duplicate to popup box 
    popcount = popcount + 1 
Else 
    d.Add cell.Value, loopI 
End If 

a$ = cell.Value 
For I = 1 To Len(a$) 
b$ = Mid(a$, I, 1) 
If b$ Like "[A-Z,a-z,0-9]" Then 
C$ = C$ & b$ 
End If 
Next I 
C$ = prefix$ & C$ 
cell.Offset(0, 1).Value = LCase(C$) 'set value 
C$ = "" 'reset c$ to nothing 
Next cell 

If popcount > 0 Then 
MsgBox ("There were " & popcount & " repeated SKUs.") 
End If 

End Sub 

---------- 
***For the Clean Image(This is the one I want to modify)** 

Private Sub Clean_Image_Click() 

Dim a$, b$, C$, count$, MyLetter$, number, ii, j, I As Integer 
Dim lr As Long 
Dim r As Range 

For intCounter = 1 To ActiveSheet.UsedRange.Columns.count 
    count$ = Cells(1, intCounter).Address(False, False) 
    Range(count$).Select 
    If ActiveCell.Value = "Image filename" Then 
     number = intCounter 
     ActiveCell.Offset(0, 1).EntireColumn.Insert 
     ActiveCell.Offset(0, 1).FormulaR1C1 = "Cleaned Image Filename" 
    Exit For 
    End If 
Next 

ii = number/26 
If ii > 1 Then 
    ii = Int(ii) 
    j = ii * 26 
    If number = j Then 
    number = 26 
    ii = ii - 1 
    Else 
    number = number - j 
    End If 
    MyLetter = ChrW(ii + 64) 
End If 

MyLetter$ = MyLetter$ & ChrW(number + 64) 
lr = Cells(Rows.count, "B").End(xlUp).Row 'find Last row 
Set r = Range(MyLetter$ & "2:" & MyLetter$ & lr) 'define working range 

For Each cell In r 
a$ = cell.Value 
a$ = Trim(a$) 
cell.Offset(0, 1).Value = a$ 'set value 
a$ = "" 'reset c$ to nothing 
Next cell 

End Sub 

おかげ

Answer 1

まず、Clean_ImageルーチンはClean_SKUルーチンが既に実行されている必要があります。それらはClean_allルーチンで正しい順序になっていますが、別々に実行できるので、クリーンスキューが既に行われていない限り、クリーンイメージが実行されないようにするコードをいくつか追加しました。

これを最初のintCounterループと "ii = number"の間に追加します。最初のintCounterループの後に述べました。そこが完了したら、イメージファイル名」欄を見つけるための1つのループになり、その後、新しいものを洗浄SKU列を取得する。

'This section will find the column that the new Cleaned SKU value is in. If it's not there, the procedure aborts. 
For intCounter = 1 To ActiveSheet.UsedRange.Columns.count 
    count$ = Cells(1, intCounter).Address(False, False) 
    Range(count$).Select 
    If ActiveCell.Value = "Cleaned SKU" Then 
     SKUColumn = intCounter 
     Exit For 
    End If 

    If SKUColumn = 0 Then 
     MsgBox "You must run the Clean SKUs program first.", vbOKOnly + vbCritical 
     Exit Sub 
    End If 
Next intCounter 

さて、あなたは画像の拡張子を見つける必要があり、スキームを使って新しいイメージファイル名を作成する$、b $などより読みやすい変数をいくつか追加しました（ああ、Dimステートメント...）トップ部分を

に変更します

Dim a$, b$, c$, SKUValue$, ImageExtension$, count$, MyLetter$, number, ii, j, I As Integer 
Dim lr As Long, SKUColumn As Long, ImageRow As Long 
Dim r As Range, cl As Range 

我々は後でDIM文について詳しく説明します。

'I didn't analyze this or try to change it, but I think it's a bit odd 
MyLetter$ = MyLetter$ & ChrW(number + 64) 
lr = Cells(Rows.count, "B").End(xlUp).Row 'find Last row 
Set r = Range(MyLetter$ & "2:" & MyLetter$ & lr) 'define working range 

'I changed 'cell' to 'cl' because cell is a reserved word, but in this instance is being used as a variable 
'and that's confusing 
For Each cl In r 
    'take the file extension from the file name (maybe it's always .jpg, and maybe it isn't. 
    ImageExtension = Right(cl.Value, 4) 
    'get the row number we're on 
    ImageRow = cl.Row 
    'and get the SKU value from the Cleaned SKU column 
    SKUValue$ = Trim(ActiveSheet.Cells(ImageRow, SKUColumn)) 'get the cleaned SKU 
    'put them together in the new column 
    cl.Offset(0, 1).Value = SKUValue & ImageExtension 
    Next cl 

これが機能するはずです。

今、DIMステートメントについて。彼らはあなたが思うように実際には動作しません。 a $、b $、c $ partは文字列変数を作成しますが、 '$'は 'number' iiであり、jは数字ではありません。各変数には、日付型を明示的に指定する必要があります。 Iのみが整数です。

これらの変更を試してください。問題がある場合や質問がある場合は、コメントを投稿してください。