小池イーサンだお(^O^)/

読んでーーーー

『ロボットはなぜ生き物に似てしまうのか―工学に立ちはだかる「究極の力学構造」』を読んだ

経緯

目次

はじめに
目次
I部 「まねる」と「似てしまう」のあいだ
II部 ロボットはなぜ、生き物に似てしまうのか?
III部 ロボットを誘惑する生き物たち──工学から見た生き物のからだの機能美
IV部 神に挑む──「生き物を超える」ロボット作りを目指して
あとがき 
参考文献 
さくいん

感想

ロボットも生き物も所詮は物体であるから、力学的・幾何学的法則から逃れることはできない。
力学的・幾何学的制約のもと機能を満たそうとすると、ロボットと生き物の構造は自然とは似てしまう、ということが書いてあった。

ロボット設計者が知恵を絞れば絞るほど、その先には生き物が待ち構えている……。(p66)

というのが印象に残っている。

じゃあ、生き物の構造が最良の形なのかというと、そんなことはない。

生き物の進化は、遺伝子レベルの突然変異によって設計変更が行われ、環境に適した優れたデザインのみが生き残るという「自然淘汰」を介して推し進められてきた。(p215)

マイナーチェンジしか行えない神様に課された設計条件の下では、腕を2本以上に増やすのは不可能だったのだ。(p216)

とあるように、マイナーチェンジを重ねるしかない生き物に対して、
ロボットはフルモデルチェンジを行える。

想像力と知恵の使い方次第で、神様の設計を超えることは十分に可能なのである。(p219)

と締めくくってあった。


四足歩行の生き物は、足を動かす順序は同じらしい。
ぼくも実際にハイハイして試してみたら同じ順序で動かしていた。
無意識に力学的・幾何学的法則に沿った順序にしてしまうみたいだ。

みんなも試してほしい。

メモ

陸上競技指導者の言う「骨盤周りを鍛えろ」につながる部分

競技力が高くなればなるほど「骨盤周りを鍛えろ」と言ってくる指導者が多かった気がする。
なぜ鍛える必要があるかを知らないまま、言われた通りトレーニングをしていた。

本書の「第4章 2足歩行ロボットはテニスプレイヤー!?」につながりそうな部分が書いてあった。
雑にまとめると、
「2足歩行ロボットのほとんどは立っていても歩いていても「中腰(=膝を少し曲げた状態)」である。
しかし、ヒトはそうではない。
なぜ、ロボットは膝を曲げないといけないのか。
それは、膝を伸ばしきることによって自由度が縮退した状態(=特異姿勢)になるのを防ぐためである。
自由度が縮退した状態とはなにか。
膝を曲げていれば、脚を前後方向にも下方向にも動かすことができる。しかし、膝を伸ばしきってしまっては上下方向に動けない(自由度が縮退する)。
自由度が縮退すると、バランスをとるのが困難になる。
では、なぜ、ヒトは膝を伸ばしていられるのか。
それは、骨盤が動くことによって、膝で行うはずの上下方向の動きを補っているからである。」
みたいなことが書いてあった。

速く走るには、地面からたくさん反発をもらわなくてはいけない。
反発のエネルギーが全身を伝搬する過程で、関節が緩んでいるとエネルギーがそこから逃げてしまう。
なので、足首・膝・腰は強く固定するように指導されてきた。
骨盤からもエネルギーが逃げるので固定しなさいよ、強い衝撃でも緩まないよう鍛えなさいよ、というだけだったのかもしれない。

体重の2倍ほどのバーベルを担いで立ち、骨盤の動きだけで脚を上下動させる(片足立ちになる)トレーニングをよく行っていた。

このトレーニングで、なぜかいつも勃起しそうだったのを思い出した。

参考

生物の構造を製品に生かした例はこの本にたくさん載っていておもしろい。
生物に学ぶイノベーション 進化38億年の超技術 (NHK出版新書)

AtCoder Beginner Contest 047を解いたよーーーー(^O^)/

AtCoder Beginner Contest 047

AtCoder Beginner Contest 047 - AtCoder Beginner Contest 047 | AtCoder

AとBだけ解けて
CとDは解けませんでした。
ガーーーン。
がんばっておべんきょうしなきゃ( ;∀;)

A問題

A: キャンディーと2人の子供 / Fighting over Candies - AtCoder Beginner Contest 047 | AtCoder

競プロ幼稚園に通う 2 人の子供がキャンディーの取り合いをしています。

3 個のキャンディーパックがあり、それぞれのパックにはキャンディーが a, b, c 個入っています。

えび先生はこの 3 個のパックを、キャンディーの個数が等しくなるように 2 人に分けようとしています。そのような分け方が可能かどうかを判定してください。

ただし、キャンディーをパックから取り出すことはできず、それぞれのパックをそのままどちらかの子供にあげる必要があります。

3個だけなのでそのまま書いてしまいました。

a, b, c = gets.split.map(&:to_i)
if (a+b==c)or(b+c==a)or(c+a==b)
	puts "Yes"
else
	puts "No"
end
少し改善

入力をソートすれば条件部分がすっきりしてよかった。

data = gets.split.map(&:to_i)
data.sort!
if (data[0] + data[1] == data[2])
	puts "Yes"
else
	puts "No"
end

B問題

B: すぬけ君の塗り絵 2 イージー / Snuke's Coloring 2 (ABC Edit) - AtCoder Beginner Contest 047 | AtCoder

xy 平面上に、左下の座標が (0,0)、右上の座標が (W,H) で、各辺が x 軸か y 軸に平行な長方形があります。最初、長方形の内部は白く塗られています。
すぬけ君はこの長方形の中に N 個の点を打ちました。i 個目 (1≦i≦N) 点の座標は (xi,yi) でした。
また、すぬけ君は長さ N の数列 a を決めて、各 1≦i≦N に対し、
ai=1 のときは長方形の x<xi をみたす領域
ai=2 のときは長方形の x>xi をみたす領域
ai=3 のときは長方形の y<yi をみたす領域
ai=4 のときは長方形の y>yi をみたす領域
を黒く塗りました。
塗りつぶしが終わったあとの長方形内での白い部分の面積を求めてください。

x,yの最大値最小値を範囲が狭まる方向に更新していけばいいだけ。

で、入力を配列に入れていこうと
以下のように書いたもののエラーになってしまい
無限に時間を溶かしてしまった。

x, y, a = Array.new(N)
for i in (1..N)
 	x[i], y[i], a[i] = gets.split.map(&:to_i)
end

prog.rb:4:in `block in

': undefined method `[]=' for nil:NilClass (NoMethodError)
from prog.rb:3:in `each'
from prog.rb:3:in `
'

結局、逐一最大値最小値を更新していくだけだから配列に保持する必要はないので単に変数で
受け取ればよかった。
もしくは行を一つの配列として受け取ればよかった。
最初のやり方に固執してしまうのは良くない。

面積が負の時0を返すようにしてしまった。
負*負=正となることに考えが至らなかった。
良くない。

W, H, N = gets.split.map(&:to_i)
 
x_max = W
x_min = 0
y_max = H
y_min = 0
 
N.times do
	x, y, a = gets.split.map(&:to_i)
	case a
	when 1
		if (x_min < x)
			x_min = x
		end
	when 2
		if (x_max > x)
			x_max = x
		end
	when 3
		if (y_min < y)
			y_min = y
		end
	when 4
		if (y_max > y)
			y_max = y
		end
	end
end
 
area = (x_max - x_min)*(y_max - y_min)
 
if (x_max - x_min) <= 0 or (y_max - y_min) <= 0
	puts 0
else
	puts area
end
少し改善

条件の不等号の向きも間違ったのでmax,min使ったほうが良かった。

W, H, N = gets.split.map(&:to_i)
 
x_max = W
x_min = 0
y_max = H
y_min = 0
 
N.times do
	x, y, a = gets.split.map(&:to_i)
	case a
	when 1
		x_min = [x_min,x].max
	when 2
		x_max = [x_max,x].min
	when 3
		y_min = [y_min,y].max
	when 4
		y_max = [y_max,y].min
	end
end
 
area = (x_max - x_min)*(y_max - y_min)
 
if (x_max - x_min) <= 0 or (y_max - y_min) <= 0
	puts 0
else
	puts area
end

==================== 解けたのはここまで ====================

C問題

C: 一次元リバーシ / 1D Reversi - AtCoder Beginner Contest 047 | AtCoder

きつねの次郎と三郎が一次元リバーシで遊んでいます。一次元リバーシでは、盤面には白か黒の石が一列に並んだ状態となっており、列の右端か左端に新たに石を打っていきます。通常のリバーシと同じように、たとえば白の石を打つことで黒の石を挟むと、挟まれた黒の石は白い石に変わります。

ゲームの途中で三郎に急用ができて帰ってしまうことになりました。このとき、盤面の状態は文字列 S で表されます。石は |S| (文字列の長さ) 個並んでおり、左から i (1≦i≦|S|) 個目の石の色は、S の i 文字目が B のとき黒、W のとき白です。

次郎は現在の盤面に対して、できるだけ少ない個数の石を新たに打つことで全ての石を同じ色にしようと考えました。最小で何個の石を打てばよいかを求めてください。

B=>W, W=>Bの境目の数を求めればよさそうだ。

とりあえずひと文字ずつ配列にして、
同じ文字が連続している場合はひとつの要素にして、
配列.lemgth-1で終わりだろう。

、、、と思ってメソッドを書いていたらうまくいかなくて放り投げてしまいました。

▼squeezeメソッド使えばやりたいことが出来たみたいです(squeeze, squeeze! (String) - Rubyリファレンス)

squeezeメソッドは、文字列中で同じ文字が連続している部分を1つの文字にまとめ、新しい文字列を返します。

s = gets.chomp
puts s.squeeze.length-1

メソッド知ってたら一瞬すぎる。

D問題

D: 高橋君と見えざる手 / An Invisible Hand - AtCoder Beginner Contest 047 | AtCoder

N 個の町が一直線上に並んでいます。行商人の高橋君は町 1 から出発し、リンゴの売買をしながら町 N へと向かいます。

はじめ高橋君は町 1 におり、リンゴを 1 つも持っていません。高橋君は次のいずれかの行動を繰り返し行います。

移動: 町 i (i<N) にいるとき、町 i+1 へ移動する。
リンゴの売買: リンゴを好きな個数だけ売買する。ここで、町 i (1≦i≦N) ではリンゴの買値も売値もともに Ai 円とする。ここで Ai は相異なる整数です。
1 つの町で売買するリンゴの個数に制限はありませんが、旅の中で売買するリンゴの個数は合計で (買う個数と売る個数を合わせて) T 個以下にしなくてはなりません。

高橋君は旅の利益、すなわちリンゴを売った代金から買った代金を引いた値を最大にするように旅をするとします。旅が終わったときに持っていたリンゴの価値は考えず、旅の中で売買した金額だけを考えます。

この旅に先立って、青木君は任意の町 i に対して Ai を好きな非負整数 Ai' に変えるという操作を好きなだけ行うことができます。ただし、この操作は行うごとに |Ai−Ai'| のコストがかかります。操作後には異なる町の間でリンゴの値段が同じになっていても構いません。

青木君の目的はできるだけ少ない合計コストの操作で高橋君の利益を少なくとも 1 円下げることです。合計コストの最小値を求めてください。

ただし、元の状態で高橋君が 1 円以上の利益を上げられることは仮定して構いません。

わからないので時間をかけてじっくり考えます( ;∀;)

ThinkPad トラックポイント・キーボー ド - 日本語(0B47208)を買ったよーーーー(^O^)/

これ!!!!

アフィリエイトではないのでご安心ください】

会社用やでな(*‘ω‘ *)

会社で支給されたノートパソコン(Thinkpad L530)と全く同じキーボードの外付け版なので、
打合せ等で本体のキーボードを使わざるを得なくなった場合でも同じ感覚で使えて良さ(*‘ω‘ *)

トラックポイントでマウス操作もできるので、
膝の上にキーボード載せて椅子の背もたれに寄りかかる楽チンスタイルで作業できるやで(*‘ω‘ *)

肩こりから解放される予感(*‘ω‘ *)


さて、そりでは、、、

開封の儀(*‘ω‘ *)

f:id:koike_e3:20161027210957j:plain
化粧箱でもないただの段ボールに保証書が張り付けてあるだけ

開けてみると、
f:id:koike_e3:20161027210959j:plain
ん~~シンプル

中身はたったこれだけ
f:id:koike_e3:20161027211001j:plain
本体、ケーブル、トリセツ

ケーブルはただのUSB-MicroUSBなので、
お好みのものに変えることが出来るみたい。
L字型のケーブルに変えたさある(*‘ω‘ *)

大きさの比較用にA5とB5のレポート用紙を並べるとこんな感じ
f:id:koike_e3:20161027214544j:plain

小さめでカワイイ(*‘ω‘ *)

自宅用に無線ヴァアジョン買っちゃおうかな(*‘ω‘ *)

おしまい(*‘ω‘ *)

文字列をある文字数ごとに区切るマクロ

業務で使う用にマクロを作る。

やりたいこと

N文字のコード値がズラズラっと並んだレコードをN文字ごとに区切りたい。
具体的には「aaaaaabbbbbcccccc」を「aaaaaa;bbbbbb;cccccc」みたいにしたい。
レコードは固定長で送られてきて、末尾はスペースで埋まっているので、
末尾のスペースは取り除きたい。

書いてみよう

インクリメントはi++もi+=1もだめらしい。
例外処理をどうするのかわからなかった。
配列のremove(削除したら前に詰めるやつ)はないらしい

低能コボラーだからクソコードしか書けないのつらい。
(自分で使うだけだから動けばいいって言い訳してる)

Sub N文字ごとに区切る()

    '''''定数
    '区切りたい文字数
    Const N As Long = 6
    '区切り文字
    Const D As String = ";"
    
    '''''変数
    Dim cell As Range
    Dim tmp As String
    Dim i As Long
    Dim err As Long: err = 0
    
    For Each cell In Selection.Cells
    
        cell = RTrim(cell)

        If (Len(cell) Mod N <> 0) Then
            err = err + 1
            GoTo Continue
        End If

        tmp = ""

        For i = N To Len(cell) Step N
            tmp = tmp & D & Mid(cell, i - (N - 1), N)
        Next i

        cell.Value = Mid(tmp, Len(D) + 1, Len(tmp))

Continue:
    Next cell
    
    MsgBox N & "文字ごとに" & D & "で区切りました" & vbLf _
            & "例外セル数:" & err
    
End Sub

AtCoder Beginner Contest 046を解いたよーーーー(^O^)/

AtCoder Beginner Contest 046

AtCoder Beginner Contest 046 - AtCoder Beginner Contest 046 | AtCoder
昨日はやまぁに遊びに誘われたから参加できず( ;∀;)
リアルタイムで参加することにこだわってないから別にええやんな(*‘ω‘ *)

イーサンはrubyで解いたよーーーー(^O^)/
いつもC,D問題は時間内に解けないor自力で解けないみたいなレベルです( ;∀;)

A問題

A: AtCoDeerくんとペンキ / AtCoDeer and Paint Cans - AtCoder Beginner Contest 046 | AtCoder
a,b,cを重複の許さない集合に放り込んで大きさを返すだけ。
javaとかpythonだとsetに.addして.sizeで済むけど、
rubyではsetがないから配列に入れた上で.uniqして.lengthしないといけない。

puts gets.split.uniq.length
結果

AC

B問題

B: AtCoDeerくんとボール色塗り / Painting Balls with AtCoDeer - AtCoder Beginner Contest 046 | AtCoder
ひとつ左隣のボールの色以外で塗っていけば、
結果的に右隣のボールの色とも違う色になる。
なので、左隣との関係だけ気にすればよい。
左端のボールの塗り方はK通り
それ以降のボールの塗り方は左隣の色を除いた(K-1)通り
なので、求めたい組み合わせは
K^1*(K-1)^(N-1)

N, K = gets.split.map(&:to_i)
puts K*((K-1)**(N-1))
結果

AC

C問題

C: AtCoDeerくんと選挙速報 / AtCoDeer and Election Report - AtCoder Beginner Contest 046 | AtCoder
「現時点での票数の比(a:b)」=「表示された票数の比(c:d)」となればうれしいので、
内項の積と外項の積を比較して、等しくなるように票数(a,b)を1ずつ足し込んでいけば
答えは出るなぁ。

a=b=1
gets.to_i.times do
  c,d=gets.split.map(&:to_i)
  until (a*d==b*c)
  	if(a*d<b*c)
  		a+=1
  	elsif (a*d>b*c)
  		b+=1
  	end
  end
end
p a+b

結果

TLE

てことで紙とペンでウンウン唸りながら考える(*・ω・)(*-ω-)(*・ω・)(*-ω-)ウンウン♪

票数は比の数値の整数倍になればよい。何倍にするかを考えないといけない。
現在の票数(t,a)と比の数値(Ti,Ai)の大小を比較して考えると、
t<Tiならt=Ti
t>Tiならt=(整数倍)*Ti
にすればいい感じがする。
(整数倍)=(t/Tiを切り上げた値)にすればいいかな。([t/Ti])
となると、t<Tiのとき[t/Ti]は1になるから大小を比較する必要がなかった。
なのでt=[t/Ti]*Tiとすればいい。
a,Aiについても同様に考えて、
a=[a/Ai]*Aiとすればいい。
で、比を保つためには[t/Ti]と[a/Ai]は同じ値じゃないといけない。
しかも、大きいほうを選ぶ必要がある(小さいほうを選ぶと票数を減らさないといけなくなる)
なので、
t=max([t/Ti],[a/Ai])*Ti
a=max([t/Ti],[a/Ai])*Ai
切り上げは.ceilだったな。
よし、書こう。
票数(a,b)、比(c,d)として読み込む。
商は小数でほしいから.map(&:to_f)で読み込まないとアカンかな?

a=b=1
gets.to_i.times do
  c,d=gets.split.map(&:to_f)
  a=[a/c,b/d].max.ceil*c
  b=[a/c,b/d].max.ceil*d
end
p (a+b).to_i
結果

WA

ファッ!?テストケースの半分くらいWAやんけ。

.map(&:to_f)が怪しいので有理数で読み込んでみよう(.map(&:to_r))

a=b=1
gets.to_i.times do
  c,d=gets.split.map(&:to_r)
  a=[a/c,b/d].max.ceil*c
  b=[a/c,b/d].max.ceil*d
end
p (a+b).to_i
結果

AC

D問題

D: AtCoDeerくんと変なじゃんけん / AtCoDeer and Rock-Paper - AtCoder Beginner Contest 046 | AtCoder
わけわかんななぁ。わかったことを書き出してみよう。
1回目は各プレイヤーはgしか出せない。(絶対にあいこ)
2回目以降gかpが出せる。(出せる手はgかpの2通り)
相手と同じ手を出し続ければあいこなので0点未満になることはない。
(gの数)≦N
(pの数)=N-(gの数)≦N/2.floor(切り捨て)

わからん。よし、愚直に書いてしまおう。
ひと文字ずつ読み込む。
相手が何を出してきても、なるべくpを出したい。
でも(pの数)≦(gの数)にしないといけない。
pが出せなかったら仕方ないからgを出す。
gとpの数、勝ち数(win)負け数(lose)を足しこんで、
win-loseを出力すればいい。

g,p,win,lose=0,0,0,0
gets.chomp.chars.each do |c|
    case c
    when 'g'
        if(g > p)
            p += 1
            win += 1
        else
            g += 1
        end
    when 'p'
        if(g > p)
            p += 1
        else
            g += 1
            lose += 1
        end
    end
end
p (win - lose)
結果

AC

初心者が解いてみた感想

A問題は簡単
B問題も簡単
C問題は答えを出すだけならすぐできるけど、
ACにするのはかなり考えないとだめ。
D問題はなにも考えずに愚直にやったら通ってしまった(これでいいなら簡単)

リアルタイムでやったらABDが解けて、Cは諦めていただろうなって感じです。

おわり(*‘ω‘ *)

取消線のついた文字を削除するためのエクセルマクロを頑張って改良したはなし

オッス、オラ小池イーサン( `ー´)ノ

この記事で作ったマクロを改良するよーーーー(^O^)/
koike-e3.hatenablog.jp

とりあえずやりたいことはできた。
けれど処理がめっちゃ遅いんだよね( ;∀;)
だから少しでも速くするためにどうすればいいか考えてみるよ(^_-)-☆

処理時間を測定しよう

次のようなシートを処理します。
f:id:koike_e3:20161013222703p:plain
・見出し行(3セル)
・セル内の部分的に取消線を施した列(10セル)
・セル全体に取消線を施した列(10セル)
・何もしていない列(10セル)
の計33セルを範囲指定して3回実行してみます。
なお、処理時間の測定は次のように行います。

Sub 取消線を削除する2()
    procStart = Timer
   ' 処理
    procEnd = Timer
    Debug.Print procEnd - procStart & "sec"
End Sub

前回の成果物

現状を把握します。

Sub 取消線を削除する2()
    procStart = Timer
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        '取消線のついていない文字を結合していく変数の初期化
        temp = ""
        'セル内の文字列を末尾から先頭に向かって調べていく
        For i = Len(moji.Value) To 1 Step -1
            'ひと文字ずつ判定し、取消線がついていればtempに結合
            If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                '末尾から調べているので先頭に結合していく
                temp = Mid(moji.Value, i, 1) & temp
            End If
        Next i
        moji.Value = temp
    Next moji
    procEnd = Timer
    Debug.Print procEnd - procStart & "sec"
End Sub
結果

18.6123sec
18.77051sec
19.83301sec

型を宣言してみよう

とりあえず動けばいいやと書いたので、変数の型が宣言がされていません。(ゆるふわ言語の良さ)
それぞれ型を宣言して実行してみましょう。

Sub 取消線を削除する2()
    '型宣言
    Dim moji As Object, temp As String, i As Long
    Dim procStart As Double, procEnd As Double
    procStart = Timer
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        '取消線のついていない文字を結合していく変数の初期化
        temp = ""
        'セル内の文字列を末尾から先頭に向かって調べていく
        For i = Len(moji.Value) To 1 Step -1
            'ひと文字ずつ判定し、取消線がついていればtempに結合
            If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                '末尾から調べているので先頭に結合していく
                temp = Mid(moji.Value, i, 1) & temp
            End If
        Next i
        moji.Value = temp
    Next moji
    procEnd = Timer
    Debug.Print procEnd - procStart & "sec"
End Sub
結果

19.146484375sec
18.8232421875sec
18.685546875sec

変わりませんね。

文字の結合方法を変えよう

「+」だとか「&」で結合するたびにメモリを確保しなおす(新しいオブジェクトが作成される?)
から効率が悪いってのが他言語でも常識なわけです。
VBAではどうするのか探してみました。
文字列を高速に連結する(Midステートメント):Excel VBA|即効テクニック|Excel VBAを学ぶならmoug
Excel VBA:高速化 > ループ内:文字列に追加連結しない - YiaoWang
マクロ高速化 - 文字列結合
が、ソレ用のクラスがあるわけではないようで、
どれも可読性を悪くするか領域の動的な確保がアレなのでパス。
うまくできませんかね。

セル単位で処理の要否を判断しよう

本命です。
これまではすべての文字に対して取消線がついているか否かを見てきました。
が、実際に取消線を付けようとするとき
①セル全体に対して取消線を施す
②セル内の文字列の一部に取消線を施す
③なにもしない

の3パターンが考えられます。
このパターンに応じて処理する・しないを分岐させるとうまくいきそうです。
「①セル全体に対して取消線を施す」だった場合、
即セル内の文字列をすべて削除できるため処理が速くなるはずです。
「②セル内の文字列の一部に取消線を施す」だった場合、
いままで通りに処理するしかないでしょう。
「③なにもしない」だった場合、
なにも処理せず次のセルを見に行くようにすれば処理が速くなるはずです。
実務では①はあまりないかもしれませんが...(全部に取消線を施すよりもセルをグレーダウンしそう)

で、パターンをどう見分けるかですが、
「セル.Font.Strikethrough」が次のように返ってきたのでそれを利用します。
①セル全体に対して取消線を施す
⇒セル.Font.Strikethrough = True
②セル内の文字列の一部に取消線を施す
⇒セル.Font.Strikethrough = Null
③なにもしない
⇒セル.Font.Strikethrough = False

以上を反映させます。
と、いきたかったんですが、

Case Null

とするとCase句の中身を実行してくれなかったので

Case Else

としました(なぜ動かないんだ??????)

Sub 取消線を削除する2()
    '型宣言
    Dim moji As Object, temp As String, i As Long
    Dim procStart As Double, procEnd As Double
    procStart = Timer
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        'Debug.Print moji.Font.Strikethrough
        'セルの属性で条件分岐
        Select Case moji.Font.Strikethrough
            'セル全体に取消線の場合
            Case True
                'Debug.Print "Case True"
                moji.Value = ""
            'なにもなしの場合
            Case False
                'Debug.Print "Case False"
            'セル内の一部分に取消線の場合
            Case Else
                'Debug.Print "Case Else"
                '取消線のついていない文字を結合していく変数の初期化
                temp = ""
               'セル内の文字列を末尾から先頭に向かって調べていく
                For i = Len(moji.Value) To 1 Step -1
                    'ひと文字ずつ判定し、取消線がついていればtempに結合
                    If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                        '末尾から調べているので先頭に結合していく
                        temp = Mid(moji.Value, i, 1) & temp
                    End If
                Next i
                moji.Value = temp
        End Select
    Next moji
    procEnd = Timer
    Debug.Print procEnd - procStart & "sec"
End Sub
結果

6.6962890625sec
6.6865234375sec
6.7529296875sec

圧倒的成長!!!!!!!!!

これでやっと実務で使えるレベル(で保守もしやすい)マクロになったやんな(*‘ω‘ *)


今回は処理の要否で分岐させて速くできました。
Case句の中身自体が工夫できればいいのですが( ;∀;)

取消線のついた文字を削除するためのエクセルマクロを頑張って作ったはなし

やぁ、小池イーサンだよ(^O^)/

今日は取消線のついた文字を削除するためのエクセルマクロを頑張って作ったはなしをするよ。

やりたいことは上に書いた通り。
具体的なイメージはこんな感じ。
f:id:koike_e3:20161012204547p:plain

取消線をシコシコ手で消すのは面倒だし、
誤ってほかの部分を消してしまうかもしれない( ;∀;)
だから機械的にやりたいなって思ったワケ(´◉◞౪◟◉)
(要件の変更は取消線で訂正されていく社内文化なのである)

とりあえず書いてみよう

Sub 取消線を削除する()
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        'セル内の文字列を末尾から先頭に向かって調べていく
        For i = Len(moji.Value) To 1 Step -1
            'ひと文字ずつ判定し、取消線がついていれば削除する
            If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = True Then
                moji.Characters(Start:=i, Length:=1).Delete
            End If
        Next i
    Next moji
End Sub

これでポチッとやってみたら動いた!!!
イーサン天才かよ(*‘ω‘ *)

しかし現実は甘くなかった

残念ながら次のような場合動かないことが分かった|д゚)
(右の数字は文字数)
f:id:koike_e3:20161012211510p:plain
文字数の少ないセルはうまくいっていたんだけど、
文字数の多いセルは削除されずに残ったままになっていたってワケ(´・ω・`)

他のマクロではこんなこと起こらなかったのになぁって思いながら
文字数が多くても処理できるソース読み返してみたの(*‘ω‘ *)

Sub 半角全角変換()
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        '半角を全角に変換する
        moji.Value = StrConv(moji.Value, vbWide)
    Next moji
End Sub

さっきはセル内の文字を処理(削除)していったけれど、
こっちはセルの内容を上書きしているって違いがあるなぁってわかったってワケ( `ー´)ノ

なるほど!上書きすればええんや( *´艸`)

改良してみよう

Sub 取消線を削除する2()
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        '取消線のついていない文字を結合していく変数の初期化
        temp = ""
        'セル内の文字列を末尾から先頭に向かって調べていく
        For i = Len(moji.Value) To 1 Step -1
            'ひと文字ずつ判定し、取消線がついていなければtempに結合
            If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                '末尾から調べているので先頭に結合していく
                temp = Mid(moji.Value, i, 1) & temp
            End If
        Next i
        moji.Value = temp
    Next moji
End Sub

これでめでたく削除できました(*‘ω‘ *)
f:id:koike_e3:20161012220514p:plain

おしまい(^O^)/