Excel VBAでのcell コピー

セルに記号を入力し、それを文字に換えます。
以前は手入力、その後セルにひな形を用意して、コピペ・・・
これでは生産性は全くあがりません。
今回厄介なのは「原型」を残す事。
「誰でも」「前のやり方」を可能にすることだそうです。
昭和頭の文系の考えそうな事、DXなどは無理。

でも、現場での生産性を上げろ!
ようわからん、自分でやってみたら、と言いたい・・・・

Sub Cell_copy()
'
' Cell_copy Macro

'
Dim y, z As Long

Dim A_c, B_c, C_c, D_c, E_c, F_c, G_c, H_c, I_c As String

Dim J_c, K_c, L_c, M_c, N_c, O_c, P_c, Q_c As String

Dim Col1_n As Long

Dim Col2_n As Long

Dim Cel_c As String

Dim rc As Long



' ひな形のある列の検出

Col1_n = Range(Cells(3, 2), Cells(3, 22)).Find("ひな形").Column

Col2_n = Col1_n + 1

rc = MsgBox("記号から作業名に変換します", vbOKCancel)

 If rc <> 1 Then
 
    End
    
 End If

A_c = Cells(9, Col1_n)
B_c = Cells(9, Col2_n)

C_c = Cells(10, Col1_n)
D_c = Cells(10, Col2_n)

E_c = Cells(11, Col1_n)
F_c = Cells(11, Col2_n)

G_c = Cells(12, Col1_n)
H_c = Cells(12, Col2_n)

I_c = Cells(14, Col1_n)
J_c = Cells(14, Col2_n)

K_c = Cells(17, Col1_n)
L_c = Cells(17, Col2_n)



For y = 9 To 48

    For z = 2 To 18
    
    If Cells(y, z) <> "" Then
      
      Cel_c = Cells(y, z)
  
      
     Debug.Print Cel_c
      
      Select Case Cel_c
       
          Case "A"
          
              Cells(y, z) = A_c
              
              Cells(y, z).Interior.ColorIndex = 6
                   
          Case "B"
          
              Cells(y, z) = B_c
              
              Cells(y, z).Interior.ColorIndex = 6
              
          Case "C"
          
              Cells(y, z) = C_c
              
              Cells(y, z).Interior.ColorIndex = 6
                   
          Case "D"
          
              Cells(y, z) = D_c
              
              Cells(y, z).Interior.ColorIndex = 6
              
          Case "E"
          
              Cells(y, z) = E_c
              
              Cells(y, z).Interior.ColorIndex = 6
                   
          Case "F"
          
              Cells(y, z) = F_c
              
              Cells(y, z).Interior.ColorIndex = 6
              
          Case "G"
          
              Cells(y, z) = G_c
              
              Cells(y, z).Interior.ColorIndex = 43
                   
          Case "H"
          
              Cells(y, z) = H_c
              
              Cells(y, z).Interior.ColorIndex = 43
              
          Case "I"
          
              Cells(y, z) = I_c
              
              Cells(y, z).Interior.ColorIndex = 6
                   
          Case "J"
          
              Cells(y, z) = J_c
              
              Cells(y, z).Interior.ColorIndex = 6
                      
              
              
       End Select
       
    End If

    Next z
    
Next y

'
End Sub





わかお かずまさ

VegaSystems


📷📷📷📷📷📷
#LAN_PRO
#Bloguru
#kuma

People Who Wowed This Post

×
  • If you are a bloguru member, please login.
    Login
  • If you are not a bloguru member, you may request a free account here:
    Request Account